home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 19
/
Aminet 19 (1997)(GTI - Schatztruhe)[!][Jun 1997].iso
/
Aminet
/
comm
/
news
/
DWdecode.lha
/
dwdecode1.02
/
DWdecode
< prev
next >
Wrap
Text File
|
1997-04-01
|
167KB
|
3,965 lines
/**************************************************************************/
/* */
/* DWDecode v1.02 */
/* */
/* */
/* Copyright ©1996-1997 by Dick Whiting */
/* */
/*========================================================================*/
/* */
/* */
/* Report bugs, comments, etc. to: */
/* */
/* Dick Whiting <dwhiting@europa.com> */
/* */
/* 01 April 1997 */
/* */
/**************************************************************************/
/*
$VER: DWDecode v1.02 Copyright ©1996-97 by Dick Whiting
*/
Parse arg commandline /* get command line options */
options failat 21 /* block rc<21 from sending msgs */
options results /* enable return codes */
SIGNAL ON IOERR
SIGNAL ON SYNTAX
Call Init /* initialize tables, vars, etc. */
Do dirptr=1 to dirlist.0 /* loop thru all directories */
Call BldFileNote /* Create filenotes for this dir */
Call ScanFiles /* Scan for key strings */
Call ReadUnknowns /* Check files w/o encode set */
Call Phase2 /* complete info in Files array */
Call ReportFiles /* generate file by file report */
Call IssueWarnings /* issue warnings - none so far */
Call FileNoteInFiles /* filenote inputs-encode & subj */
Call BuildLists /* build array for decoding use */
Call DecodeFiles /* do the actual decoding */
Call DoOldFiles /* handle Delete/Mark old files */
Call ListStats /* report time & cnts for dir */
Call DumpArrays /* dump arrays for this dir */
if verbose then do
say time() 'Done processing 'dirlist.dirptr
say ' '
end
end
Cleanup:
if exists(DWtemp'DWdecode.scan') then do /* delete the scan file */
Address Command 'Delete 'DWtemp'DWdecode.scan QUIET'
end
if exists(DWtemp'DWdecode.temp') then do /* delete the join temporary file*/
Address Command 'Delete 'DWtemp'DWdecode.temp QUIET'
end
Address Command 'Assign ' DWassignIN /* remove the DW assign */
pragma('D',origdir) /* reset to original directory */
exit
/**************************************************************************/
/* */
/* Build the filenote string as requested in FILENOTE=var */
/* */
/* Variable fnote may contain variables for later interpretation. */
/* */
/**************************************************************************/
BldFileNote:
if Filenote~='' then do
fnote=filenote
do j=words(filenote) to 1 by -1
select
when upper(word(filenote,j))='%SOURCE' then do
wptr=wordindex(filenote,j)-1
fnote=delword(fnote,j,1)
sdir="'"||'dirlist.dirptr'||"'"
fnote=insert(sdir,fnote,wptr,length(sdir)+1,' ')
end
when upper(substr(word(filenote,j),1,4))='%LLQ' then do
llqnum=substr(word(filenote,j),5)
if llqnum='' then llqnum=1
if ~datatype(llqnum,'N') then llqnum=99
if llqnum<1 then llqnum=99
llq=translate(dirlist.dirptr,' ',':/')
if llqnum>words(llq) then llqnum=words(llq)
llq=subword(llq,words(llq)-llqnum+1)
wptr=wordindex(filenote,j)-1
fnote=delword(fnote,j,1)
fnote=insert(llq,fnote,wptr,length(llq)+1,' ')
end
when upper(substr(word(filenote,j),1,4))='%HLQ' then do
hlqnum=substr(word(filenote,j),5)
if hlqnum='' then hlqnum=1
if ~datatype(hlqnum,'N') then hlqnum=1
if hlqnum<1 then hlqnum=1
hlq=translate(dirlist.dirptr,' ',':/')
if hlqnum>words(hlq) then hlqnum=words(hlq)
hlq=subword(hlq,1,hlqnum)
wptr=wordindex(filenote,j)-1
fnote=delword(fnote,j,1)
fnote=insert(hlq,fnote,wptr,length(hlq)+1,' ')
end
when upper(substr(word(filenote,j),1,5))='%QUAL' then do
qnum1=substr(word(filenote,j),6,1)
if qnum1='' then qnum1=1
if ~datatype(qnum1,'N') then qnum1=1
if qnum1<1 then qnum=1
qual=translate(dirlist.dirptr,' ',':/')
if qnum1>words(qual) then qnum1=words(qual)
qnum2=substr(word(filenote,j),7,1)
if qnum2='' then qnum2=words(qual)
if ~datatype(qnum2,'N') then qnum2=words(qual)
if qnum2<1 then qnum=words(qual)
if qnum2>words(qual) then qnum2=words(qual)
qual=subword(qual,qnum1,qnum2)
wptr=wordindex(filenote,j)-1
fnote=delword(fnote,j,1)
fnote=insert(qual,fnote,wptr,length(qual)+1,' ')
end
when upper(word(filenote,j))='%SUBJECT' then do
wptr=wordindex(filenote,j)-1
fnote=delword(fnote,j,1)
subj="'"||'Subjinfo.Filesptr.1.1'||"'"
fnote=insert(subj,fnote,wptr,length(subj)+1,' ')
end
when upper(word(filenote,j))='%DATE' then do
wptr=wordindex(filenote,j)-1
fnote=delword(fnote,j,1)
date="'"||'Dateinfo.Filesptr.1.1'||"'"
fnote=insert(date,fnote,wptr,length(date)+1,' ')
end
when upper(word(filenote,j))='%FROM' then do
wptr=wordindex(filenote,j)-1
fnote=delword(fnote,j,1)
from="'"||'Frominfo.Filesptr.1.1'||"'"
fnote=insert(from,fnote,wptr,length(from)+1,' ')
end
otherwise nop
end
end
fnote=strip(fnote) /* remove extra blanks */
fnote="'"||fnote||"'" /* enclose string in quotes */
end /* matches with filenote~='' */
Return
/**************************************************************************/
/* */
/* Scan directory for key strings used for identifying encode type, part */
/* information and header information. */
/* */
/* !! Should allow for multiple search programs, but not sure of output */
/* parsing handling. The command could be specified as a template. */
/* */
/**************************************************************************/
/* */
/* Read the lines from the sorted scan array. Determine what kind of */
/* line it is and store appropriately for Date:, From:, and Subject: */
/* */
/* Look for valid Section and begin lines. Get whatever info possible. */
/* Look for valid Base64 indicators and store info as available. */
/* */
/* The next routine will try to handle completing any parts using the */
/* information in the subject lines. */
/* */
/* ASSUMPTIONS: */
/* 1) If file has a valid Section or begin line then it is UUencoded. */
/* 2) If an 'end' line occurs after a begin, it is a 1/1 part. */
/* 3) If file has a valid Base64 line then the file is Base64 encoded. */
/* 4) If a nth Base64 marker occurs, assume previous one is complete. */
/* 5) Files with multiple encoded parts are 1/1 files */
/* */
/*========================================================================*/
/* ARRAY FORMATS */
/*========================================================================*/
/* (0)=cnt (0)=cnt */
/* Files. format: filename.encodetype.partname.partnum.parttot.startline */
/* .encodetype.partname.partnum.parttot.startline */
/* */
/* (Y/N/.) (Y/.) (Y/.) (Y/.) */
/* Miscinfo. format: filename.mimetype.decoded.filenoted.chopped.dupfile */
/* */
/* (0)=cnt */
/* Subjinfo. format: skipflag.deleteflag.textline */
/* Frominfo. format: skipflag.deleteflag.textline */
/* Dateinfo. format: skipflag.deleteflag.textline */
/* */
/* (0)#partname matches in subject line */
/* (0)#partnums in subject line */
/* (0)#totals in sub */
/* Files spart spart */
/* Partone. format: Pointer.partname.sword.number.loc.total.loc.subjline */
/* */
/* Partxxx.=same format as Partone. */
/* */
/**************************************************************************/
ScanFiles:
starttm=time('S') /* start time for processing this directory */
Address Command 'Assign ' DWassignIN dirlist.dirptr /*for shorter lines*/
ScanArray.=missing /* stores parsed information from scan prg */
ScanArray.0=0 /* no scan lines yet */
Files.=missing /* stores information for each news file */
Files.0=0 /* no File info yet */
Miscinfo. =missing /* stores additional info for file/parts */
Miscinfo.0=0 /* no Misc info yet */
Subjinfo. =missing /* init to missing */
Subjinfo.0=0 /* no Subject lines yet */
Frominfo. =missing /* init to missing */
Frominfo.0=0 /* no From lines yet */
Dateinfo. =missing /* init to missing */
Dateinfo.0=0 /* no Date lines yet */
Partone. =missing /* init to missing */
Partone.0=0 /* no partone lines yet */
part1cnt=0 /* no partone lines yet */
Partxxx. =missing /* init to missing */
Partxxx.0=0 /* no partxxx lines yet */
partXcnt=0 /* no partxxx lines yet */
Parts.0=0 /* init to zero - report */
Temppart.0=0 /* init to zero - report */
AllBegins.0=0 /* lines with begin */
AllEncodes.0=0 /* MIME encoding info */
AllSections.0=0 /* lines with section */
warnings.0=0 /* used for warning msgs */
if verbose then say time() 'Scanning ' dirlist.dirptr '...'
Address Command scanprog dirlist.dirptr 'From: cs nh num > ' DWtemp'DWdecode.scan'
Address Command scanprog dirlist.dirptr 'Subject: cs nh num >> ' DWtemp'DWdecode.scan'
Address Command scanprog dirlist.dirptr 'Date: cs nh num >> ' DWtemp'DWdecode.scan'
Address Command scanprog dirlist.dirptr 'section nh num >> ' DWtemp'DWdecode.scan'
Address Command scanprog dirlist.dirptr 'begin cs nh num >> ' DWtemp'DWdecode.scan'
Address Command scanprog dirlist.dirptr 'end cs nh num >> ' DWtemp'DWdecode.scan'
Address Command scanprog dirlist.dirptr 'Content- cs nh num >> ' DWtemp'DWdecode.scan'
Address Command scanprog dirlist.dirptr 'number= cs nh num >> ' DWtemp'DWdecode.scan'
do i=1 to Base64Types.0
Address Command scanprog dirlist.dirptr Base64Types.i ' cs nh num >> ' DWtemp'DWdecode.scan'
end
if verbose then say time() 'Reading the scan file ...'
goodopen=open('IN',DWtemp'DWdecode.scan','R')
if ~goodopen then do
msg='(E) Error in opening ' DWtemp'DWdecode.scan'
interpret Saycmd
msg=' No further processing for this directory possible'
interpret Saycmd
exit
end
dirname=dirlist.dirptr /* name of directory */
device=substr(dirname,1,pos(':',dirname)) /* get device portion */
directs=substr(dirname,pos(':',dirname)+1) /* remaining portion */
if upper(device)='RAM:' then dirname='Ram Disk:'||directs /* fix Ram: */
dirlen=length(dirname) /* length of dir name */
filename=missing /* init to missing */
sptr=0 /* scanarray pointer */
do until eof('IN')
linein=readln('IN')
select
when pos(dirname,linein)=1 & word(linein,words(linein))='...' then do
fullname=subword(linein,1,words(linein)-1) /* name with path */
filename=substr(fullname,dirlen+1) /* just the filename part*/
if pos('/',filename)>0 then do
filename=substr(filename,lastpos('/',filename)+1)
end
end
when words(linein)=2 & word(linein,2)='...' then do
fullname=word(linein,1) /* filename with path */
filename=substr(fullname,dirlen+1) /* just the filename part*/
if pos('/',filename)>0 then do
filename=substr(filename,lastpos('/',filename)+1)
end
end
when words(linein) > 0 then do
linenum=strip(word(linein,1)) /* line number found */
linenum=right(linenum,6,'0') /* put in leading zeros */
text=subword(linein,2) /* remaining string */
select
when word(text,1)='Newsgroups:' then nop
when word(text,1)='Xref:' then nop
when substr(word(text,1),1,2)='X-' then nop
when word(text,1)='Content-Description:' then nop
otherwise do
sptr=sptr+1 /* increment cnter */
scanarray.0=sptr /* store it */
scanarray.sptr=filename linenum text /* put it in array */
end
end
end
otherwise nop /* should be end of file */
end
end
result=close('IN') /* close the scan file */
if verbose then say time() 'Sorting the scan array ...'
if show('L','rexxtricks.library') then do /* use tricks library */
call QSORT(scanarray) /* sort by name, line number */
end
else do /* use QuickSort format */
call QSORT(1,scanarray.0,scanarray) /* sort by name, line number */
end
if DEBUG=YES then do
msg=' '
interpret Saycmd
msg='Dumping ScanArray ...'
interpret Saycmd
msg=left(dashes,length(msg))
interpret Saycmd
do i=1 to scanarray.0 /* for debugging */
msg=scanarray.i
interpret Saycmd
end
msg=' '
interpret Saycmd
end
SkipSubjCnt=0 /* used for reporting */
SkipFromCnt=0 /* used for reporting */
B64OutCnt=0 /* used for reporting */
UUOutCnt=0 /* used for reporting */
BinOutCnt=0 /* used for reporting */
oldfile=missing /* break control on file */
oldsection=missing /* used to trap end sect.*/
fptr=0 /* files array pointer */
partname=missing /* no partname yet */
partnum=missing /* no partnum yet */
parttot=missing /* no part total yet */
partlin=missing /* decode start line num */
pptr=0 /* zero to start with */
encode=missing /* init to missing */
beginfound=NO /* no begins found yet */
CCdata=NO /* NO Content data yet */
if verbose then say time() 'Processing the scan array ...'
do i=1 to scanarray.0
filename=word(scanarray.i,1) /* filename in array */
linenum=word(scanarray.i,2) /* line number in array */
text=subword(scanarray.i,3) /* remainder of line */
text=translate(text,' ',cr) /* remove PC Ctrl-M */
if filename~=oldfile then do /* got a level break */
if encode~=missing then Call StorePartVars /* do previous part */
if oldfile~=missing then do
skipflag=NO /* didn't do any skips */
Call CheckSkips /* handle Skip/Deletes */
if skipflag=YES then do /* clear array entries */
Files.fptr.1=missing /* clear encode value */
Frominfo.fptr.1.1=missing
Subjinfo.fptr.1.1=missing
Dateinfo.fptr.1.1=missing
encode=missing /* clear control vars */
fptr=fptr-1 /* reuse current slot */
pptr=0 /* clear control vars */
end
end
oldfile=filename /* copy for next break */
fptr=fptr+1 /* next files. pointer */
Files.0=fptr /* count the file */
Files.fptr=filename /* store filename */
Files.fptr.1.0=0 /* no parts yet */
Dateinfo.fptr=0 /* don't skip */
Dateinfo.fptr.1=0 /* don't delete */
Frominfo.fptr=0 /* don't skip */
Frominfo.fptr.1=0 /* don't delete */
Subjinfo.fptr=0 /* don't skip */
Subjinfo.fptr.1=0 /* don't delete */
pptr=0 /* partname slot pointer */
Call ResetPartVars /* reset partname vars */
oldsection=missing /* used to trap end sect.*/
end
select
when word(text,1)='From:' & Frominfo.fptr.1.1=missing then do
text=translate(text,' ','"`') /* blank all type quotes */
text=translate(text,' ',"'") /* blank all type quotes */
Frominfo.fptr.1.1=substr(text,7) /* store From info */
end
when word(text,1)='Subject:' & Subjinfo.fptr.1.1=missing then do
text=translate(text,' ','"`') /* blank all type quotes */
text=translate(text,' ',"'") /* blank all type quotes */
Subjinfo.fptr.1.1=substr(text,10) /* store Subject info */
end
when word(text,1)='Date:' & Dateinfo.fptr.1.1=missing then do
Dateinfo.fptr.1.1=substr(text,7)
end
when pos('SECTION',upper(word(text,1)))>0 then do
Call CheckSections
Call StorePartVars /* complete set - store */
end
when substr(text,1,6)='begin ' & datatype(word(text,2),'N') then do
partnum=1 /* begins are part ones */
bpname=strip(subword(text,3)) /* get partname portion */
if partname~=bpname then do /* didn't have a section */
partname=bpname /* begin line partname */
encode='UU' /* encode type */
partlin=linenum /* good starting point in file */
Call StorePartVars /* complete set - store */
end
beginfound=YES /* indicator for 'end ' */
end
when word(text,1)='end' & encode='UU' & beginfound=YES then do
parttot=1 /* !! total - unused ? */
Call StorePartVars /* store what we've got */
Call ResetPartVars /* reset partname vars */
end
when pos('Content-',word(text,1))=1 then do
Call CheckContent
if CCdata=YES & Ctype>1 & encode ~=missing then do
Call StorePartVars /* store what we've got */
Call ResetPartVars /* reset partname vars */
end
end
otherwise do
if encode=missing then do /* not from a Content- */
Call CheckBase64 /* non-MIME B64 encoding */
if encode='64' then do /* found a B64 start str */
partnum=1 /* begins are part ones */
encode='64' /* encode type */
Call StorePartVars /* store what we've got */
Call ResetPartVars /* reset partname vars */
end
end
end
end
end /* matches do i=1 to scanarray.0 */
skipflag=NO /* NO skips yet */
Call CheckSkips /* check LAST file */
if skipflag=YES then fptr=fptr-1 /* don't count last one */
if encode~=missing & skipflag=NO then Call StorePartVars /*last part */
Files.0=fptr /* count of files found */
Frominfo.0=fptr /* count of files found */
Subjinfo.0=fptr /* count of files found */
Dateinfo.0=fptr /* count of files found */
Miscinfo.0=fptr /* count of files found */
ScanFilesEnd:
Return
/**************************************************************************/
/* Check for Skip/Delete based on Subject: or From: lines. If SKIP then */
/* filenote the file and reuse Files. slot. If DELETE then delete the */
/* file and reuse the slot. Skipped/Deleted will not appear on any rpts */
/* or be included in the match logic phases. */
/* */
/* Date deletes will be flagged for handling after the Decoding. */
/**************************************************************************/
DoOldFiles:
If MarkOld | DeleteOld then do
do fptr=1 to Files.0
if ~exists(DWassignIN||Files.fptr) then iterate fptr /* gone */
if DeleteOld & ~ScanOnly then do
if Dateinfo.fptr.1=YES then do
Address Command 'Delete' DWassignIN||Files.fptr 'QUIET'
end
end
else do
if Dateinfo.fptr.1=YES then do
fnsubj=Subjinfo.fptr.1.1 /* subject for filenote */
fnsubj=substr(fnsubj,1,75) /* shorten to max length */
if Files.fptr.1=missing then fnsubj='O '||fnsubj
else fnsubj='O'||Files.fptr.1||' '||fnsubj
filein=DWassignIN||Files.fptr
Address Command 'Filenote 'filein '"'fnsubj'" '
end
end
end
end
Return
/**************************************************************************/
/* */
/* Report counts and time information for this directory */
/* */
/**************************************************************************/
ListStats:
if ShowStats then do
totfiles=SkipSubjCnt+SkipFromCnt+Files.0
if totfiles=0 then signal ListStatsEnd
maxval=max(Files.0,Parts.0,Temppart.0,totfiles)
rlen=length(maxval)
msg=' '
interpret saycmd
msg=right(totfiles,rlen) 'File(s) in 'dirlist.dirptr
interpret saycmd
msg=right(SkipSubjCnt,rlen) 'File(s) skipped/deleted due to Subject: matches'
interpret saycmd
msg=right(SkipFromCnt,rlen) 'File(s) skipped/deleted due to From: matches'
interpret saycmd
msg=right(Temppart.0,rlen) 'Encoded pieces completely identified'
interpret saycmd
complete=0
do j=1 to parts.0
if parts.j.1=parts.j.1.0 then complete=complete+1
end
msg=right(complete,rlen) 'Complete encoded files (excludes duplicates)'
interpret saycmd
msg=right(UUOutCnt,rlen) 'UU Encoded output files written'
interpret saycmd
msg=right(B64OutCnt,rlen) 'Base64 Encoded output files written'
interpret saycmd
msg=right(BinOutCnt,rlen) 'BinHex Encoded output files written'
interpret saycmd
endtm=time('S')
elapstm=endtm-starttm
hh=elapstm%3600
hh=right(hh,2,'0')
elapstm=elapstm-(3600*hh)
mm=elapstm%60
mm=right(mm,2,'0')
ss=elapstm-(60*mm)
ss=right(ss,2,'0')
msg=copies(' ',rlen) 'Processing time for this directory:' hh':'mm':'ss
interpret Saycmd
end
ListStatsEnd:
Return
/**************************************************************************/
/* Check for Skip/Delete based on Subject: or From: lines. If SKIP then */
/* filenote the file and reuse Files. slot. If DELETE then delete the */
/* file and reuse the slot. Skipped/Deleted will not appear on any rpts */
/* or be included in the match logic phases. */
/* */
/* Date deletes will be flagged for handling after the Decoding. */
/**************************************************************************/
CheckSkips:
If SkipFrom | DeleteFrom then do
do skipcnt=1 to SkipFroms.0
if pos(upper(SkipFroms.skipcnt),upper(Frominfo.fptr.1.1))>0 then do
if DeleteFrom & ~ScanOnly then do
Address Command 'Delete' DWassignIN||Files.fptr 'QUIET'
end
else do
fnsubj=Subjinfo.fptr.1.1 /* subject for filenote */
fnsubj=substr(fnsubj,1,75) /* shorten to max length */
if Files.fptr.1=missing then fnsubj='F '||fnsubj
else fnsubj='F'||Files.fptr.1||' '||fnsubj
filein=DWassignIN||Files.fptr
Address Command 'Filenote 'filein '"'fnsubj'" '
end
skipflag=YES
SkipFromCnt=SkipFromCnt+1
leave skipcnt
end
end
end
If SkipSubject | DeleteSubject then do
do skipcnt=1 to SkipSubjects.0
if pos(upper(SkipSubjects.skipcnt),upper(Subjinfo.fptr.1.1))>0 then do
if DeleteSubject & ~ScanOnly then do
if exists(DWassignIN||Files.fptr) then do
Address Command 'Delete' DWassignIN||Files.fptr 'QUIET'
end
end
else do
fnsubj=Subjinfo.fptr.1.1 /* subject for filenote */
fnsubj=substr(fnsubj,1,75) /* shorten to max length */
if Files.fptr.1=missing then fnsubj='S '||fnsubj
else fnsubj='S'||Files.fptr.1||' '||fnsubj
filein=DWassignIN||Files.fptr
if ~skipflag then Address Command 'Filenote 'filein '"'fnsubj'" '
end
if ~skipflag then do
skipflag=YES
SkipSubjCnt=SkipSubjCnt+1
end
leave skipcnt
end
end
end
If (MarkOld | DeleteOld) & Dateinfo.fptr.1.1~=missing then do
datemsg=Dateinfo.fptr.1.1
Call TimeStamp
if (today-days)>KeepDays then do
Dateinfo.fptr.1=YES
end
end
Return
/**************************************************************************/
/* Attach a filenote to each of the input files with encode & subject */
/* This is the time to DELETE non-binaries if requested to. */
/**************************************************************************/
FileNoteInFiles:
msg='Filenoting input files '
if DeleteText then msg=msg||'and Deleting Text files '
msg=msg||'...'
if verbose then say time() msg
do i=1 to Files.0
filein=DWassignIN||Files.i /* name of file w/path */
if DeleteText & Files.i.1=missing then do /* a 'text' file */
Address Command 'Delete ' filein ' QUIET'
iterate i /* go onto next file */
end
fnsubj=Subjinfo.i.1.1 /* subject for filenote */
fnsubj=substr(fnsubj,1,75) /* shorten to max length */
select
when Files.i.1=missing then do
encoding='Not an encoded file'
Address Command 'Filenote 'filein '" '||fnsubj||'" '
fnrc=rc
end
when Files.i.1='UU' then do
encoding='UUencode'
Address Command 'Filenote 'filein '" UU '||fnsubj||'" '
fnrc=rc
end
when Files.i.1='64' then do
encoding='Base64'
Address Command 'Filenote 'filein '" 64 '||fnsubj||'" '
fnrc=rc
end
when Files.i.1='BH' then do
encoding='BinHex'
Address Command 'Filenote 'filein '" BH '||fnsubj||'" '
fnrc=rc
end
otherwise nop
end
if fnrc>0 then do
say 'Filenote returned RC='fnrc 'for 'filein
say 'Subject: 'fnsubj
end
end
Return
/**************************************************************************/
/* */
/* Reset variables used to identify partnames, number, etc. */
/* */
/**************************************************************************/
ResetPartVars:
if pptr>1 then do /* an nth encode in file */
prev=pptr-1 /* point to prev part */
Files.fptr.1.prev.1.1=1 /* must be a part 1/1 */
end
if encode~=missing then Files.fptr.1.0=pptr /* store partname cnt */
partname=missing /* no partname yet */
partnum=missing /* no partnum yet */
parttot=missing /* no part total yet */
partlin=missing /* decode start line num */
encode=missing /* null for encoding */
pptr=pptr+1 /* NEXT part for filename*/
beginfound=NO /* no begins found yet */
CCdata=NO /* NO Content data yet */
Ctype=0 /* no Content-type yet */
Return
/**************************************************************************/
/* */
/* Store variables used to identify partnames, number, etc. */
/* */
/**************************************************************************/
StorePartVars:
if encode~=missing then do
Files.fptr.1.0=pptr
Files.fptr.pptr=encode
end
if partname~=missing then do
Files.fptr.1.pptr=partname
end
if partnum~=missing then do
Files.fptr.1.pptr.1=partnum
end
if parttot~=missing then do
Files.fptr.1.pptr.1.1=parttot
end
if partlin~=missing then do
Files.fptr.1.pptr.1.1.1=partlin
end
Return
/**************************************************************************/
/* */
/* See if this one has Section information (we hope so) */
/* */
/**************************************************************************/
CheckSections:
if text=oldsection then signal CheckSectionsEnd /* a closing section */
if pos('SECTION',upper(text))>0 & TrapAllSecs then do
AllSections.0=1+AllSections.0
secptr=AllSections.0
AllSections.secptr=filename':'text
end
do k=1 to sectiontypes.0 /* loop thru various forms */
matchctr=0 /* zero matches at start */
do l=1 to sectiontypes.k /* number of keys to test */
key1=sectiontypes.k.l /* primary search key */
key1loc=sectiontypes.k.l.l /* location of primary key */
if word(text,key1loc)=key1 then matchctr=matchctr+1
else iterate k /* on any mismatch quit loop */
end
if matchctr =sectiontypes.k then do /* found a KNOWN section */
wpartnum =sectiontypes.k.1.1.1 /* word holding partnum */
wparttot =sectiontypes.k.1.1.1.1 /* word holding total */
wpartname=sectiontypes.k.1.1.1.1.1 /* name of file */
partsep =sectiontypes.k.1.1.1.1.1.1 /* delimiter char */
if wpartnum=wparttot & wpartnum~=missing then do
partword=word(text,wpartnum) /* get the word */
partnum=substr(partword,1,pos(partsep,partword)-1)
parttot=substr(partword,pos(partsep,partword)+1)
end
else do
if wpartnum~=missing then partnum=word(text,wpartnum)
if wparttot~=missing then parttot=word(text,wparttot)
end
if wpartname~=missing then partname=word(text,wpartname)
if ~datatype(partnum,'N') then partnum=missing
if ~datatype(parttot,'N') then parttot=missing
encode='UU' /* Sections mean UU encoding */
partlin=linenum /* good starting point in file */
oldsection=text /* use to trap ending section */
leave k /* got everything we could from the SECTION */
end /* if matchctr=sectiontypes.k */
else do
/* !!! should not get here !!! */
say 'Should not be here--- Check Sections'
end
end /* do k=1 to sectiontypes.0 */
if pos('SECTION',upper(text))>0 then do /* unknown section found */
if TrapNewSecs=YES & k>sectiontypes.0 then do
if exists(TrapNewSecsFile) then mode='A'
else mode='W'
goodopen=open('TRAPSECS',TrapNewSecsFile,mode)
if ~goodopen then do
msg='(E) Unable to open TrapSecFile:'TrapNewSecsFile
interpret Saycmd
msg=' Setting TrapNewSecs=NO'
interpret Saycmd
end
result=writeln('TRAPSECS',text)
result=close('TRAPSECS')
end /* matches if TrapNewSecs=YES */
end /* matches unknown section */
CheckSectionsEnd:
Return
/**************************************************************************/
/* */
/* Handle the Content- type lines */
/* */
/**************************************************************************/
CheckContent:
Select
When word(text,1)='Content-Type:' & ,
CCdata=YES & Ctype>0 & encode~=missing then do
Ctype=Ctype+1
i=i-1 /* redo this line next iteration*/
end
When word(text,1)='Content-Type:' then do
Ctype=0 /* any previous wasn't encoded */
Call CheckCType
end
When word(text,1)='Content-Transfer-Encoding:' then do
Call CheckCEncoding
end
When word(text,1)='Content-Disposition:' then do
Call CheckCDisp
end
Otherwise nop
end
CheckContentEnd:
Return
/**************************************************************************/
/* */
/* Handle Content-Type lines */
/* */
/**************************************************************************/
CheckCType:
Select
when upper(word(text,2))='MULTIPART/MIXED;' then nop
when upper(word(text,2))='MESSAGE/PARTIAL;' then do
Call NextCline
if substr(CCword1,1,7)='number=' & substr(CCword2,1,6)='total=' then do
Call CheckCNumber
end
else do
if substr(CCword1,1,3)='id=' then do /* a scan word in id */
i=i+1 /* skip over id line */
Call NextCline
if substr(CCword1,1,7)='number=' & substr(CCword2,1,6)='total=' then do
Call CheckCNumber
end
end
end
end /* matches MESSAGE/PARTIAL */
otherwise do /* all other content-types for now */
Ctype=Ctype+1 /* count Content-type */
if pos('name=',word(text,3))=1 then do
partname=subword(text,3)
squote=pos('"',partname)
if squote>0 then do
equote=lastpos('"',partname)-(squote+1)
partname=substr(partname,squote+1,equote)
end
else do
partname=strip(substr(partname,6))
end
CCdata=YES
end
end /* matches otherwise other Content-Types */
end /* matches Content-Type Select */
CheckCTypeEnd:
Return
/**************************************************************************/
/* */
/* Point to next line in scanarray */
/* */
/**************************************************************************/
NextCline:
CCi=i+1 /* temp pointer for next line */
CCfile=word(scanarray.CCi,1)
CCtext=subword(scanarray.CCi,3)
CCtext=translate(CCtext,' ',tab)
CCword1=strip(word(CCtext,1))
CCword2=strip(word(CCtext,2))
Return
/**************************************************************************/
/* */
/* Handle number= for Partials */
/* */
/**************************************************************************/
CheckCNumber:
partnum=substr(CCword1,8)
partnum=strip(translate(partnum,' ',';'))
parttot=substr(CCword2,7)
parttot=strip(translate(parttot,' ',';'))
i=CCi
CCdata=YES
Return
/**************************************************************************/
/* */
/* Handle Content-Encoding lines */
/* */
/**************************************************************************/
CheckCEncoding:
if TrapAllEncs then do
AllEncodes.0=1+AllEncodes.0
encptr=AllEncodes.0
AllEncodes.encptr=filename':'text
end
do k=1 to EncTypes.0 /* loop thru various forms */
matchctr=0 /* zero matches at start */
if upper(word(text,2))=upper(EncTypes.k) then do
matchctr=1 /* found a match */
if EncTypes.k.1~=missing then do
encode=upper(EncTypes.k.1) /* store encode type */
partlin=linenum /* good starting point in file */
if partnum=missing & encode='64' then partnum=1
CCdata=YES
end
leave k
end
end /* do k=1 to EncTypes.0 */
if TrapNewEncs=YES & matchctr=0 then do /* must be a new encode type */
if exists(TrapNewEncsFile) then mode='A'
else mode='W'
goodopen=open('TRAPENCS',TrapNewEncsFile,mode)
if ~goodopen then do
msg='(E) Unable to open TrapEncFile:'TrapNewEncsFile
interpret Saycmd
msg=' Setting TrapNewEncs=NO'
interpret Saycmd
end
result=writeln('TRAPENCS',text)
result=close('TRAPENCS')
end /* matches if TrapNewEncs=YES */
Return
/**************************************************************************/
/* */
/* Handle Content-Disposition lines */
/* */
/**************************************************************************/
CheckCDisp:
if pos('filename',word(text,3))=1 then do
partname=subword(text,3)
squote=pos('"',partname)
if squote>0 then do
equote=lastpos('"',partname)-(squote+1)
partname=substr(partname,squote+1,equote)
end
else do
partname=strip(substr(partname,10))
end
CCdata=YES
end
CheckCDispEnd:
Return
/**************************************************************************/
/* */
/* Handle the Base64 - type lines */
/* */
/**************************************************************************/
CheckBase64:
do k=1 to Base64Types.0 /* loop thru various forms */
key1=Base64Types.k /* primary search key */
key1loc=1 /* location of primary key */
if pos(key1,text)=key1loc then do /* found a match for Base64 */
partlin=linenum
encode='64' /* Base64 encoding */
leave k /* stop looking */
end
end /* do k=1 to Base64Types.0 */
Return
/**************************************************************************/
/* */
/* Read all unidentified files looking for UU encoded lines. Only files */
/* with encode=missing are read. Should be part x/y and should only have */
/* a few lines of header info. Not like part 1/y where leading text may */
/* be hundreds of lines. Use MaxHeader=25 or less and should be quick. */
/* */
/**************************************************************************/
/* !!! BinHexed files are showing up as Base64 - !!! Modified 1/7/97 */
/**************************************************************************/
ReadUnknowns:
if verbose then say time() 'Reading unidentified files for encoded lines ...'
do i=1 to Files.0
if Files.i.1=missing then do /* check file for encoded lines */
filein=DWassignIN||Files.i
goodopen=open('IN',filein,'R')
if ~goodopen then do
msg='(E) Error in processing input file' filein
interpret Saycmd
msg=' Attempting to continuing with next file'
interpret Saycmd
iterate
end
j=1 /* loop control variable */
mcount=0 /* reset UU line counter */
bcount=0 /* reset 64 line counter */
bhfile=NO /* not a BinHex file */
do until j>MaxHeader | mcount=MinEncoded | eof('IN')
linein=readln('IN')
linein=strip(linein,'T') /* strip trailing blanks */
Select
when substr(linein,1,1)='M' & pos(' ',linein)=0 then do
mcount=mcount+1
bcount=0 /* if an 'M' then not 64 */
end
when length(linein)>40 & pos(' ',linein)=0 then do
bcount=bcount+1
mcount=0
end
when linein='(This file must be converted with BinHex 4.0)' then do
bhfile=YES
bcount=0
mcount=0
j=MaxHeader /* force end of loop */
end
otherwise nop
end
j=j+1 /* NEXT line number */
end
Select
when mcount>=MinEncoded then do
Files.i.1='UU' /* a UU encoded file */
Files.i.1.0=1 /* 1 entry in array */
end
when bcount>=MinEncoded then do
Files.i.1='64' /* Base 64 file?) */
Files.i.1.0=1
end
when bhfile=YES then do
Files.i.1='BH' /* Binhex file */
Files.i.1.0=1 /* assume single part */
Files.i.1.1.1=1 /* mark as a 1/y file */
/*
Files.i.1.1.1.1=1 /* assume a 1/1 file !!! */
*/
end
otherwise nop
end
result=close('IN') /* close the input file */
end
end
Return
/**************************************************************************/
/* First loop thru files and any that have multiples within a single file */
/* are marked as part 1/1. This assumes we don't have multiple PARTS for */
/* files that have multiple encodes within them. */
/* */
/* Next: */
/* locate all encoded files with a missing value for name, num, or total */
/* To complete this information we need to trust the information in the */
/* subject line and make some 'reasonalbe' assumptions. We will also */
/* use comparing of subject lines to connect part x/y with the part 1/y */
/**************************************************************************/
Phase2:
if verbose then say time() 'Starting Phase2 part identification ...'
part1cnt=0 /* count of part 1/. pieces */
partXcnt=0 /* count of part x/y pieces */
do i=1 to Files.0
Select
when Files.i.1=missing then nop /* not an encoded file - skip */
when Files.i.1.0=1 then do /* 1 and only 1 part */
partname=Files.i.1.1
partnum=Files.i.1.1.1
parttot=Files.i.1.1.1.1
if partname=missing | partnum=missing | parttot=missing then do
Call CheckSubject
end
else do
if parttot > 1 then do
Call CheckSubject
end
end
end
when Files.i.1.0>1 then do j=1 to Files.i.1.0 /* multiple in file*/
if Files.i.1.j.1=1 & Files.i.1.j.1.1=missing then do
Files.i.1.j.1.1=1
end
else do
if Files.i.1.j.1~=1 & Files.i.1.j.1.1=missing then do
Say 'Found multi parts with first not = 1'
Say Files.i Files.i.1 Files.i.1.j Files.i.1.j.1 Files.i.1.j.1.1
end
end
end
otherwise do
if DEBUG then do
Say 'Found otherwise condition in Phase2'
Say Files.i Files.i.1 Files.i.1.0 Files.i.1.1 Files.i.1.1.1 Files.i.1.1.1.1
end
end
end
end
Call Phase2Files
Return
/**************************************************************************/
/* Scan subject line looking for the partname previously identified. If */
/* found mark where it/they occur. */
/* */
/* If we don't have a partname, then use the bintypes array to locate all */
/* potential filenames and mark where they occur. */
/* */
/**************************************************************************/
CheckSubject:
subjline=Subjinfo.i.1.1 /* current subject line */
testword=missing /* init to missing */
spctr=0 /* counter for spartnames */
spartname.=missing /* init to missing */
spartname.0=0 /* no partnames in subject */
subjpn=missing /* init to missing */
subjpt=missing /* init to missing */
pncnt=0 /* counter for subject pns */
ptcnt=0 /* counter for subject pts */
/*****************************************************/
/* Get rid of all the braces, brackets, & parens. */
/* This should take care of problems where user */
/* didn't leave a blank between filename and part */
/* information. */
/* */
/* Locate all possible binary file names in the */
/* subject line. May be different ones or multiple */
/* ones of the same name. */
/* */
/* If a part 1/x (known from "begin" line) locate */
/* if and where the partname is in the subject. */
/* This will be used as a match locator in phase2. */
/* If we can't locate it we will try to use the */
/* partname we do find in the subject. (Probably a */
/* typo by the user). If there isn't any name in */
/* the subject we will use the entire subject line */
/* for matches. */
/* */
/* For non 1/x parts, we try to get a subject name */
/* and part information. This will be for reporting */
/* purposes only if we don't have the part 1 for it.*/
/* */
/*****************************************************/
subjline=translate(subjline,' ','()[]{}')
/*****************************************************/
/* Count possible file names in the subject line */
/*****************************************************/
do k=1 to words(subjline) /* loop thru subject line */
sword=word(subjline,k) /* copy for ease */
if partname~=missing then do /* already have a name */
if upper(partname)=upper(sword) then do /* handle as found */
spctr=spctr+1 /* count another */
spartname.0=spctr /* increment .0 ctr */
spartname.spctr=word(subjline,k) /* store it */
spartname.spctr.1=k /* which word it is */
iterate k /* skip bin type search */
end
end
do l=1 to Bintypes.0 /* loop thru binary types */
if upper(substr(sword,1,7))='HTTP://' then iterate
if upper(substr(sword,1,4))='WWW.' & upper(right(sword,4))='.COM' then iterate
if upper(right(sword,length(bintypes.l)))=upper(bintypes.l) then do
spctr=spctr+1 /* count another */
spartname.0=spctr /* increment .0 ctr */
spartname.spctr=word(subjline,k) /* store it */
spartname.spctr.1=k /* which word it is */
leave l /* only count first match */
end
end
end
/*****************************************************/
/* if a part 1 - see how many subject part names */
/* match actual begin name and where in subject. */
/*****************************************************/
spctr=0 /* reset to zero b4 using */
if partnum=1 then do /* found via SECTION or begin line */
part1cnt=part1cnt+1 /* another part one piece */
Partone.0=part1cnt /* store it */
Partone.part1cnt=i /* pointer to file array */
Partone.part1cnt.1=partname /* name of binary file */
Partone.part1cnt.1.0=0 /* no matches yet */
Partone.part1cnt.1.1.1.1.1.1.1=subjline /* store a copy */
if partname~=missing then do k=1 to spartname.0
if upper(partname)=upper(spartname.k) then do
spctr=spctr+1 /* increment match ctr */
Partone.part1cnt.1.0=spctr /* count it */
Partone.part1cnt.1.spctr=spartname.k.1 /* where in subject */
end
end
else do /* a part one without a part name */
Partone.part1cnt.1.0=spartname.0 /* how many in subject line */
do k=1 to spartname.0
Partone.part1cnt.1.k=spartname.k.1 /* where in subject line */
end
end
end
else do /* NOT a part 1 piece -- store info for matching */
partXcnt=partXcnt+1 /* another part xxx piece */
Partxxx.0=partXcnt /* store it */
Partxxx.partXcnt=i /* pointer to file array */
Partxxx.partXcnt.1.1.1.1.1.1.1=subjline /* store a copy */
if partname~=missing then Partxxx.partXcnt.1=partname /* know name */
Partxxx.partXcnt.1.0=spartname.0 /* how many in subject line */
do k=1 to spartname.0
Partxxx.partXcnt.1.k=spartname.k.1 /* where in subject line */
end
end /* matches else do - NOT a part 1 piece */
/*****************************************************/
/* Look for x/y, (x/y), [x/y], {x/y} formats */
/* and count how many occurrences */
/*****************************************************/
/* IF MORE THAN 1 '/' in word skip that word. */
/* (it is probably a date in the mm/dd/yy form) */
/*****************************************************/
if partnum=missing | parttot=missing | parttot>1 then do
do j=1 to words(subjline)
testword=word(subjline,j)
if pos('/',testword)>0 then do
if pos('/',testword)~=lastpos('/',testword) then iterate j
testword=translate(testword,' ','/') /* strip "/" character */
pn=strip(word(testword,1))
pt=strip(word(testword,2))
if datatype(pn,'N') & datatype(pt,'N') then do
subjpn=strip(pn,'L','0')
subjpt=strip(pt,'L','0')
pncnt=pncnt+1 /* found a subj part num */
ptcnt=ptcnt+1 /* found a subj total */
if partnum=1 then do /* from section or begin */
Partone.part1cnt.1.1.0=pncnt /* store subj part numcnt*/
Partone.part1cnt.1.1.pncnt=subjpn /* store part num */
Partone.part1cnt.1.1.pncnt.1=j /* which word in sub */
Partone.part1cnt.1.1.1.1.0=ptcnt /* store subj total cnt*/
Partone.part1cnt.1.1.1.1.ptcnt=subjpt /* store part tot */
Partone.part1cnt.1.1.1.1.ptcnt.1=j /* word in subj */
end
else do
Partxxx.partXcnt.1.1.0=pncnt /* store subj part numcnt*/
Partxxx.partXcnt.1.1.pncnt=subjpn /* store part num */
Partxxx.partXcnt.1.1.pncnt.1=j /* which word in sub */
Partxxx.partXcnt.1.1.1.1.0=ptcnt /* store subj total cnt*/
Partxxx.partXcnt.1.1.1.1.ptcnt=subjpt /* store part tot */
Partxxx.partXcnt.1.1.1.1.ptcnt.1=j /* word in subj */
end
end
end
end
end
/*****************************************************/
/* */
/* Look for partnumbers in form (xx of yy) */
/* */
/*****************************************************/
if partnum=missing | parttot=missing | parttot>1 then do
do j=2 to words(subjline)-1 by 1 /* loop thru subject line */
of=word(subjline,j) /* copy it for ease */
if upper(of)='OF' then do
pn=word(subjline,j-1)
pt=word(subjline,j+1)
pn=translate(pn,' ','()[]{}/')
pt=translate(pt,' ','()[]{}/')
pn=strip(pn)
pt=strip(pt)
if datatype(pn,'N') & datatype(pt,'N') then do
subjpn=strip(pn,'L','0')
subjpt=strip(pt,'L','0')
pncnt=pncnt+1 /* found a subj part num */
ptcnt=ptcnt+1 /* found a subj total */
if partnum=1 then do /* from section or begin */
Partone.part1cnt.1.1.0=pncnt /* store subj part numcnt*/
Partone.part1cnt.1.1.pncnt=subjpn /* store part num */
Partone.part1cnt.1.1.pncnt.1=j-1 /* which word in sub */
Partone.part1cnt.1.1.1.1.0=ptcnt /* store subj total cnt*/
Partone.part1cnt.1.1.1.1.ptcnt=subjpt /* store part tot */
Partone.part1cnt.1.1.1.1.ptcnt.1=j+1 /* word in subj */
end
else do
Partxxx.partXcnt.1.1.0=pncnt /* store subj part numcnt*/
Partxxx.partXcnt.1.1.pncnt=subjpn /* store part num */
Partxxx.partXcnt.1.1.pncnt.1=j-1 /* which word in sub */
Partxxx.partXcnt.1.1.1.1.0=ptcnt /* store subj total cnt*/
Partxxx.partXcnt.1.1.1.1.ptcnt=subjpt /* store part tot */
Partxxx.partXcnt.1.1.1.1.ptcnt.1=j+1 /* word in subj */
end
end
end
end
end
/*****************************************************/
/* */
/* Look for partnumbers in form (xxofyy) */
/* */
/*****************************************************/
if partnum=missing | parttot=missing | parttot>1 then do
do j=1 to words(subjline) /* loop thru subject line */
of=word(subjline,j) /* copy it for ease */
if pos('OF',upper(of))>0 then do
pn=substr(of,1,pos('OF',upper(of)))
pt=substr(of,pos('OF',upper(of))+2)
pn=translate(pn,' ','()[]{}/')
pt=translate(pt,' ','()[]{}/')
pn=strip(pn)
pt=strip(pt)
if datatype(pn,'N') & datatype(pt,'N') then do
subjpn=strip(pn,'L','0')
subjpt=strip(pt,'L','0')
pncnt=pncnt+1 /* found a subj part num */
ptcnt=ptcnt+1 /* found a subj total */
if partnum=1 then do /* from section or begin */
Partone.part1cnt.1.1.0=pncnt /* store subj part numcnt*/
Partone.part1cnt.1.1.pncnt=subjpn /* store part num */
Partone.part1cnt.1.1.pncnt.1=j /* which word in sub */
Partone.part1cnt.1.1.1.1.0=ptcnt /* store subj total cnt*/
Partone.part1cnt.1.1.1.1.ptcnt=subjpt /* store part tot */
Partone.part1cnt.1.1.1.1.ptcnt.1=j /* word in subj */
end
else do
Partxxx.partXcnt.1.1.0=pncnt /* store subj part numcnt*/
Partxxx.partXcnt.1.1.pncnt=subjpn /* store part num */
Partxxx.partXcnt.1.1.pncnt.1=j /* which word in sub */
Partxxx.partXcnt.1.1.1.1.0=ptcnt /* store subj total cnt*/
Partxxx.partXcnt.1.1.1.1.ptcnt=subjpt /* store part tot */
Partxxx.partXcnt.1.1.1.1.ptcnt.1=j /* word in subj */
end
end
end
end
end
Return
/**************************************************************************/
/* */
/* Attempt to fill out part 1/y information. The assumption is that if */
/* the partname is in the subject and the next word is a valid xx/yy */
/* or 'xx of yy' form, and 'xx'=1 THEN the yy portion is probably */
/* correct. A person could enter an invalid /yy portion, but unlikely. */
/* */
/* If we find a word that fits these conditions, store where the part */
/* number and total are to be found for the final subject line match */
/* logic. */
/* */
/**************************************************************************/
/* need to handle name in subject but partnums aren't after the pn */
/* assume if we have one and only one 1/y then it is correct. */
/* with or without a partname in the subject. Done - */
/**************************************************************************/
Phase2Files:
If Debug then Say time() 'Starting 1/y condition ...'
/* Files spart spart */
/* Partone. format: Pointer.partname.sword.number.loc.total.loc.subjline */
do j=1 to Partone.0
if Partone.j.1=missing then iterate /* no partname anywhere */
if Partone.j.1.0>0 & Partone.j.1.1.1.1.0>0 then do
do k=1 to Partone.j.1.0 /* check name matches */
do l=1 to Partone.j.1.1.1.1.0 /* against total matches */
nword=Partone.j.1.k /* word with name */
pword=Partone.j.1.1.l.1 /* word with part number */
tword=Partone.j.1.1.1.1.l.1 /* word with total value */
if pword=tword then nword=nword+1 /* an xx/yy or xxofyy */
else nword=nword+3 /* an xx of yy form */
testpn=Partone.j.1.1.l /* xx portion of xx/yy */
if nword=tword & testpn=1 then do
fptr=Partone.j /* pointer to files array*/
Files.fptr.1.1.1.1=Partone.j.1.1.1.1.l /* assume correct*/
Partone.j.1.1.1.0=l /* entry of partnumber */
Partone.j.1.1.1.1.1.0=l /* entry of total number */
iterate j /* go on to next partone.*/
end
end
end /* next see if xx/yy is separated from part name */
if Partone.j.1.1.0=1 & Partone.j.1.1.1.1.0=1 then do
testpn=Partone.j.1.1.1 /* xx portion of xx/yy */
if testpn=1 then do /* only one and it is 1/y*/
fptr=Partone.j /* pointer to files array*/
Files.fptr.1.1.1.1=Partone.j.1.1.1.1.1 /* assume correct*/
Partone.j.1.1.1.0=1 /* entry of partnumber */
Partone.j.1.1.1.1.1.0=1 /* entry of total number */
iterate j /* go on to next partone.*/
end
end
end /* matches with partname and parttotal in subject */
else do /* probably no partname in subject use xx/yy if single */
if Partone.j.1.1.0=1 & Partone.j.1.1.1.1.0=1 then do
testpn=Partone.j.1.1.1 /* xx portion of xx/yy */
if testpn=1 then do /* only one and it is 1/y*/
fptr=Partone.j /* pointer to files array*/
Files.fptr.1.1.1.1=Partone.j.1.1.1.1.1 /* assume correct*/
Partone.j.1.1.1.0=1 /* entry of partnumber */
Partone.j.1.1.1.1.1.0=1 /* entry of total number */
iterate j /* go on to next partone.*/
end
end
end
end
/**************************************************************************/
/* */
/* Big Assumption Time: If NO total has been found anywhere (section, */
/* mime, or subject) then ASSUME that it is a (1/1). This happens for */
/* a lot of files. The subject just says 'xxxx.jpg' and some text. */
/* The other form is a subject with 1/1 but without the part name. */
/* Consider these valid 1/1 parts also. */
/* */
/**************************************************************************/
Phase2Scan:
If Debug then Say time() 'Starting 1/1 Scanning ...'
do j=1 to Partone.0 /* loop thru part names */
if Partone.j.1.1.1.1.0=missing then do /* check all w/o a total */
Partone.j.1.1.1.1.0=1 /* set as if in sub */
Partone.j.1.1.1.1.1=1 /* set to value 1 */
fptr=Partone.j /* pointer to files array*/
Files.fptr.1.1.1.1=1 /* fix in files. */
end
else do /* total not missing */
/**********************************************************/
/* only one [1/1] in the subject, but partname is not in */
/* a begin line/section/etc. OR not in the subject. */
/* Consider these valid 1/1 parts also. */
/**********************************************************/
if Partone.j.1.1=missing | Partone.j.1=missing then do
if Partone.j.1.1.1.1.0=1 & Partone.j.1.1.1.1.1=1 then do
fptr=Partone.j /* pointer to files array*/
Files.fptr.1.1.1.1=1 /* fix in files. */
end
end
end
end
Phase2ScanEnd:
/**************************************************************************/
/* */
/* The last group to process in Partone. are the 1/y with information */
/* in the subjects. We will do some comparing against the Partxxx array */
/* to try to FIRMLY connect the xx/yy parts to the part 1/yy. */
/* */
/**************************************************************************/
Phase2Match:
If Debug then Say time() 'Starting 1/yy to xx/yy matching ...'
/*
say 'j fptr p1match p1tots pval offset p1word'
*/
do j=1 to Partone.0 /* last time thru loop */
if Partone.j.1=missing then iterate /* missing partname */
if Partone.j.1.1.1.1.0>0 then do /* check all with totals */
fptr=Partone.j /* pointer to files */
if Files.fptr.1.1.1.1>1 then do /* yep, a 1/y, not a 1/1 */
p1match=Partone.j.1.1.1.1.1.1.1 /* subject line */
p1tots=Partone.j.1.1.1.1.0 /* number of tots in sub */
pval=Partone.j.1.1.1.0 /* identified in Phase2Files as valid */
if pval=missing then pval=Partone.j.1.1.0 /* use LAST PN */
offset=-1 /* needed for shrinking */
do k=1 to Partone.j.1.1.0 /* remove xx word subj */
offset=offset+1 /* for next time */
p1word=Partone.j.1.1.k.1 /* word to remove */
/*
say 'Partone.j.1.1.0='Partone.j.1.1.0
say j fptr p1match p1tots pval offset p1word
*/
p1word=p1word-offset /* correction factor */
p1match=delword(p1match,p1word,1)
end
do m=1 to Partxxx.0 /* now loop thru xx/yy */
p2match=Partxxx.m.1.1.1.1.1.1.1 /* subject line */
p2tots=Partxxx.m.1.1.1.1.0 /* number of tots in sub */
if p2tots~=p1tots then iterate m /* must be different */
do n=1 to p1tots /* compare totals */
if Partone.j.1.1.1.1.n ~= Partxxx.m.1.1.1.1.n then iterate m
end
Xptr=Partxxx.m /* pointer to files array*/
offset=-1 /* needed for shrinking */
do k=1 to Partxxx.m.1.1.0 /* remove xx word subj */
offset=offset+1 /* for next time */
p1word=Partone.j.1.1.k.1 /* word to remove */
/*
say j fptr p1match p1tots pval offset p1word
*/
p1word=p1word-offset /* correction factor */
p2match=delword(p2match,p1word,1) /* remove same here */
end
if p1match=p2match then do /* should be a match */
Files.Xptr.1.1=Partone.j.1 /* name from part1 */
Files.Xptr.1.1.1=Partxxx.m.1.1.pval
Files.Xptr.1.1.1.1=Partxxx.m.1.1.1.1.pval
Partxxx.m.1=Partone.j.1 /* name from part1 */
end
end /* matches do m=1 to Partxxx.0 */
end /* matches if Files.fptr.1.1>1 */
end /* matches if Partone.j.1.1.1.1.0>0 */
end /* matches do j=1 to Partone.0 */
Phase2MatchEnd:
/**************************************************************************/
/* */
/* The final group of files are part x/y that failed matching with a */
/* part 1/y. They also had no MIME or Section information available. */
/* Let's TRUST the subject for information IFF there is ONLY 1 partname */
/* possible we will use it. Similarly for x/y information. IFF there is */
/* only 1 potential partnum/parttot we will use it. If missing or mult- */
/* iple, we give it up. */
/* Do this for the Partones also but only if B64 or BinHex. */
/**************************************************************************/
/* Need to allow for multiple names in subject that are ALL THE SAME */
/* then treat them as correct. Done. */
/**************************************************************************/
Phase2FinalTry:
If Debug then Say time() 'Starting use subject only ...'
do j=1 to Partxxx.0 /* last time thru loop */
Xptr=Partxxx.j /* pointer to files array*/
/* if unknown partname AND only 1 potential name in subject - use it*/
if Files.Xptr.1~=missing & Files.Xptr.1.1=missing then do
AllSame=YES /* flag for testing */
pXnams=Partxxx.j.1.0 /* numb of names in sub */
if pXnams>0 then do /* see if all the same */
sword=Partxxx.j.1.1 /* which word in subject */
subject=Partxxx.j.1.1.1.1.1.1.1 /* subject line */
savename=word(subject,sword) /* save the first one */
do k=1 to Partxxx.j.1.0 /* loop thru them */
sword=Partxxx.j.1.k /* which word in subject */
partname=word(subject,sword) /* nth name in subject */
if partname ~= savename then do /* different name found */
AllSame=NO /* set flag */
leave k /* quit looking */
end
end
if AllSame then Files.Xptr.1.1=partname /* ALL were the same */
end
end
/* if unknown partnum AND only 1 potential name in subject - use it*/
if Files.Xptr.1~=missing & Files.Xptr.1.1.1=missing then do
pXnums=Partxxx.j.1.1.0 /* number of nums in sub */
if pXnums=1 then Files.Xptr.1.1.1=Partxxx.j.1.1.1
end
/* if unknown parttot AND only 1 potential name in subject - use it*/
if Files.Xptr.1~=missing & Files.Xptr.1.1.1.1=missing then do
pXtots=Partxxx.j.1.1.1.1.0 /* number of tots in sub */
if pXtots=1 then Files.Xptr.1.1.1.1=Partxxx.j.1.1.1.1.1
end
end
do j=1 to Partone.0 /* last time thru loop */
ptr=Partone.j /* pointer to files array*/
/* if Partname missing AND B64 and only 1 potential name - use it */
if (Files.ptr.1='64' | Files.ptr.1='BH') & Files.ptr.1.1=missing then do
pnams=Partone.j.1.0 /* numb of names in sub */
if pnams=1 then do
sword=Partone.j.1.1
subject=Partone.j.1.1.1.1.1.1.1
partname=word(subject,sword)
Files.ptr.1.1=partname
end
end
end
Return
/**************************************************************************/
/* */
/* Report File information in this Phase */
/* */
/* Generate report of all input files for this directory at this point in */
/* the processing. */
/* */
/* Logic: Loop thru Files array picking up the information from the other */
/* arrays as necessary. */
/* */
/**************************************************************************/
ReportFiles:
if ~ShowFiles then signal ReportFilesEnd
msg=' '
interpret Saycmd
msg=dirlist.dirptr ' Processing: ' Files.0 'File(s)'
interpret Saycmd
msg=left(dashes,length(msg))
interpret Saycmd
do rptptr=1 to files.0 /* loop thru files array */
msg='Filename:' Files.rptptr /* report name of file */
interpret Saycmd
msg='Subject: ' Subjinfo.rptptr.1.1 /* report subject line */
interpret Saycmd
select
when Files.rptptr.1=missing then do
msg='Encoding: Not an encoded file'
interpret Saycmd
msg=' '
interpret Saycmd
end
when Files.rptptr.1='UU' then do
msg='Encoding: UUencode'
interpret Saycmd
do pptr=1 to Files.rptptr.1.0
msg='Name: ' Files.rptptr.1.pptr
interpret Saycmd
msg='Part: ' Files.rptptr.1.pptr.1 'of' Files.rptptr.1.pptr.1.1
interpret Saycmd
end
msg=' '
interpret Saycmd
end
when Files.rptptr.1='64' then do
msg='Encoding: Base64'
interpret Saycmd
do pptr=1 to Files.rptptr.1.0
msg='Name: ' Files.rptptr.1.pptr
interpret Saycmd
msg='Part: ' Files.rptptr.1.pptr.1 'of' Files.rptptr.1.pptr.1.1
interpret Saycmd
end
msg=' '
interpret Saycmd
end
when Files.rptptr.1='BH' then do
msg='Encoding: BinHex'
interpret Saycmd
do pptr=1 to Files.rptptr.1.0
msg='Name: ' Files.rptptr.1.pptr
interpret Saycmd
msg='Part: ' Files.rptptr.1.pptr.1 'of' Files.rptptr.1.pptr.1.1
interpret Saycmd
end
msg=' '
interpret Saycmd
end
otherwise encoding=Files.rptptr.1 /* should never happen */
end
end
ReportFilesEnd:
Return
/**************************************************************************/
/* */
/* Create arrays as needed for processing. */
/* */
/**************************************************************************/
BuildLists:
Temppart.0=0
if Files.0>0 then do
msg=' '
interpret Saycmd
end
errorcnt=0
pnlen=0 /* length of partname */
fnlen=0 /* length of filename */
Do fptr=1 to Files.0
filename=Files.fptr
encode=Files.fptr.1 /* encoding method */
if encode=missing then iterate /* not encoded */
Do pptr=1 to Files.fptr.1.0 /* loop thru partnames */
partname=Files.fptr.1.pptr
partname=translate(partname,tab,' ') /* for names with blanks */
partnum =Files.fptr.1.pptr.1
parttot =Files.fptr.1.pptr.1.1
pnlen=max(pnlen,length(partname)) /* longest length for rpt */
fnlen=max(fnlen,length(filename)) /* longest length for rpt */
if partnum~=missing & parttot~=missing & partname~=missing & ,
filename~=missing then do
Temppart.0=1+Temppart.0
ptr=Temppart.0
Temppart.ptr=partname encode parttot partnum filename fptr pptr
end
else do
if errorcnt=0 then do
msg='Errors: Filename Encode Partname Partnum Parttot Pptr ("."=missing)'
interpret saycmd
msg=left(dashes,length(msg))
interpret Saycmd
errorcnt=1
end
msg='(E) Missing information for file:' filename encode partname partnum parttot pptr
interpret saycmd
end
end
end
pnlen=min(pnlen,30) /* maximum Amiga name len */
if show('L','rexxtricks.library') then do /* use tricks library */
call QSORT(Temppart) /* put into order */
end
else do /* use QuickSort */
call QSORT(1, Temppart.0, Temppart) /* put into order */
end
if DEBUG=YES then do
msg=' '
interpret Saycmd
msg='Dumping Temppart array:'
interpret saycmd
msg=left(dashes,length(msg))
interpret Saycmd
do j=1 to Temppart.0
msg=Temppart.j
interpret Saycmd
end
msg=' '
interpret Saycmd
end
oldname=missing
oldtotal=missing
oldencode=missing
Parts.=missing
Parts.0=0
do j=1 to Temppart.0
if word(Temppart.j,1)~=oldname | word(Temppart.j,2)~=oldencode |,
word(Temppart.j,3)~=oldtotal then do
oldname=word(Temppart.j,1) /* Save to old name */
oldencode=word(Temppart.j,2) /* Save to old encode */
oldtotal=word(Temppart.j,3) /* Save to old total */
Parts.0=1+Parts.0 /* a new partname */
ptr=Parts.0 /* count it */
partname=word(Temppart.j,1) /* get partname */
partname=translate(partname,' ',tab) /* return blanks to name */
Parts.ptr=partname /* store partname */
Parts.ptr.1=word(Temppart.j,3) /* Total Parts Expected */
partnum=word(Temppart.j,4) /* part number sets slot */
filename=word(Temppart.j,5) /* filename */
fptr=word(Temppart.j,6) /* pointer into Files. */
pptr=word(Temppart.j,7) /* pointer for partname */
Parts.ptr.1.partnum=filename /* store it in pn slot */
Parts.ptr.1.partnum.1=fptr /* pointer into Files. */
Parts.ptr.1.partnum.1.1=pptr /* pointer to part info */
Parts.ptr.1.0=1 /* indicate 1 part found */
end
else do
partnum=word(Temppart.j,4) /* part number sets slot */
filename=word(Temppart.j,5) /* filename */
fptr=word(Temppart.j,6) /* pointer into Files. */
pptr=word(Temppart.j,7) /* pointer for partname */
if Parts.ptr.1.partnum=missing then do /* slot not already used */
Parts.ptr.1.0=1+Parts.ptr.1.0 /* 1 more part found */
end /* don't count mult. but use nth version - fixes Apple/DBL */
else do
oldfptr=Parts.ptr.1.partnum.1
oldpptr=Parts.ptr.1.partnum.1.1
miscinfo.oldfptr.oldpptr.1.1.1.1=YES /* mark as duplicate */
end
Parts.ptr.1.partnum=filename /* put filename in it */
Parts.ptr.1.partnum.1=fptr /* pointer into Files. */
Parts.ptr.1.partnum.1.1=pptr /* pointer to part info */
end
end
if ~ShowParts then signal BuildListsEnd
if parts.0=0 then signal BuildListsEnd
msg=' '
interpret Saycmd
msg='Encoded parts:'
interpret saycmd
msg='Output name'
msg=overlay('xxx of yyy',msg,pnlen+5)
msg=overlay('Input Name',msg,length(msg)+5)
interpret saycmd
msg=left(dashes,length(msg))
interpret Saycmd
do j=1 to Parts.0
msg=' '
interpret saycmd
do k=1 to Parts.j.1
msg=substr(Parts.j,1,pnlen)
msg=overlay(k,msg,pnlen+8-length(k))
msg=overlay('of',msg,length(msg)+2)
msg=overlay(Parts.j.1,msg,length(msg)+2)
tfile=right(parts.j.1.k,fnlen)
msg=overlay(tfile,msg,length(msg)+8-length(Parts.j.1))
interpret Saycmd
end
end
msg=' '
interpret Saycmd
BuildListsEnd:
Return
/**************************************************************************/
/* */
/* Finally do the Decoding. */
/* Strip ALL PATH information prior to decoding. */
/**************************************************************************/
DecodeFiles:
if verbose then say time() 'Starting Decoding ...'
pragma('D',dest) /* change directory to destination */
curdir=pragma('D') /* check to make sure changed */
if ShowDecode & parts.0 > 0 then do
msg=' '
interpret Saycmd
msg='Decoding to Directory ... 'curdir
interpret Saycmd
msg=left(dashes,length(msg))
interpret Saycmd
msg=' '
interpret Saycmd
end
do i=1 to parts.0 /* loop thru all output files */
if parts.i.1=parts.i.1.0 then do /* we have all necessary parts */
Filesptr=parts.i.1.1.1 /* pointer into Files array */
Pptr=parts.i.1.1.1.1 /* pointer to part within file */
encode=Files.filesptr.1 /* type of encoding */
partname=parts.i /* get partname for decoding */
if pos('/',partname)>0 then do /* strip path information */
partname=substr(partname,lastpos('/',partname)+1)
end
else do
if pos(':',partname)>0 then do
partname=substr(partname,lastpos(':',partname)+1)
end
end
msg=substr(partname,1,pnlen) /* name of output file */
filestr='' /* init to null on new partname*/
if encode='UU' then msgenc='UU decoding from -'
else msgenc='B64 decoding from -'
msg=overlay(msgenc,msg,pnlen+3)
if replace=NO then do /* check replace output file */
if exists(partname) then do /* already exists */
if Miscinfo.Filesptr.pptr.1=missing then do /* decode~=YES */
filestr='' /* init to null for file list */
do k=1 to parts.i.1 /* build list of files skipped */
tfile=right(parts.i.1.k,fnlen)
tfptr=parts.i.1.k.1 /* file pointer for this part */
tpptr=parts.i.1.k.1.1
Miscinfo.tfptr.tpptr.1.1.1.1=YES /* duplicate output */
if filestr='' then filestr=tfile
else filestr=filestr||' '||tfile
end
msg=substr(partname,1,pnlen) /* reset to just partname */
msg=overlay('exists; skipping -',msg,pnlen+3)
msg=overlay(Filestr,msg,length(msg)+3)
if ShowDecode then interpret SayCmd
iterate i
end
else do /* we decoded it as part of another partname */
filestr=parts.i.1.1 /* should be 1/1 of another */
say 'Hit else do in REPLACE=NO of decodefiles: for ' filestr files.filesptr
Call IssueDecodeMsg
Call FileNoteOut
iterate i
end
end
end
Call BldDecodeStr
Select /* !!! added */
When encode='UU' then Call DecodeUUFiles
When encode='64' then Call Decode64Files
When encode='BH' then Call DecodeBHFiles
otherwise do
if DEBUG then do
say 'Found otherwise line 1945 for i='i 'encode='encode 'filesptr='filesptr
end
end
end
end /* matches parts.i.1=parts.i.1.0 */
end /* matches do i=1 to parts.0 */
/**************************************************************************/
/* */
/* Handle DELETEAFTER and DELETEDUPS options. */
/* */
/* Delete any decoded files and any duplicates, but only IF no errors */
/* The CHOPPED files may have duplicate names and decoded in a single */
/* file and the possibility there was an error for only 1 of the pieces.*/
/* */
/* The files that weren't chopped only need to be checked if delete */
/* duplicates was specified. If so then the dup flag is set in Miscinfo.*/
/* */
/**************************************************************************/
do i=1 to Files.0
deccnt=0
dupcnt=0
delflag=NO
partcnt=Files.i.1.0
if partcnt=0 then iterate i
do j=1 to partcnt
if Miscinfo.i.j.1=YES then deccnt=deccnt+1
if Miscinfo.i.j.1.1.1.1=YES then dupcnt=dupcnt+1
end
if DeleteAfter & deccnt>0 & deccnt+dupcnt=partcnt then delflag=YES
if DeleteDups & dupcnt=partcnt then delflag=YES
if delflag & ~scanonly then do
Address Command 'Delete ' DWassignIn||Files.i 'QUIET'
end
end
pragma('D',progdir) /* change dir back to progdir */
curdir=pragma('D') /* check to make sure changed */
if debug then do
msg=' '
interpret Saycmd
msg='Changing Directory to ... 'curdir
interpret Saycmd
msg=' '
interpret Saycmd
end
DecodeFilesEnd:
if verbose then say time() 'Done Decoding ...'
Return
/**************************************************************************/
/* */
/* Handle chopping, joining, ect. for decoding */
/* */
/**************************************************************************/
BldDecodeStr:
joinstr='' /* init to null */
chopflag=NO /* no chopping done */
Select
when parts.i.1=1 & Files.filesptr.1.0=1 then do /* a single 1/1 file*/
filestr=right(parts.i.1.1,fnlen) /* name of file */
filein=DWassignIN||parts.i.1.1 /* with assign path */
Miscinfo.Filesptr.pptr.1=YES /* mark as decoded */
Call IssueDecodeMsg
end
when parts.i.1=1 & Files.filesptr.1.0>1 then do
filein=DWassignIN||parts.i.1.1 /* with assign path */
if Miscinfo.Filesptr.pptr.1.1.1=missing then Call ChopFile
filestr=right(parts.i.1.1,fnlen)
filein=DWtemp||Files.filesptr||'.'||pptr /* build chopped name */
Miscinfo.Filesptr.pptr.1=YES /* mark as decoded */
Call IssueDecodeMsg
chopflag=YES /* filein is a T:CHOPPED */
end
when parts.i.1>1 then do
filestr=''
do k=1 to parts.i.1 /* loop thru list of files required */
Filesptr=parts.i.1.k.1 /* pointer into Files array */
do j=1 to Files.Filesptr.1.0 /* mark all multi's as decoded */
Miscinfo.Filesptr.j.1=YES /* mark as decoded */
end
tfile=right(parts.i.1.k,fnlen)
if filestr='' then filestr=tfile
else filestr=filestr||' '||tfile
joinstr=joinstr||' '||DWassignIN||parts.i.1.k
end /* matches do k=1 to parts.i.1 */
Call IssueDecodeMsg
filein=DWtemp'DWdecode.temp'
Address Command 'Join ' joinstr 'AS' filein
joinrc=rc
if joinrc>0 then do
say ' JOIN returned rc='joinrc 'for 'partname
say joinstr 'AS' filein
end
end
otherwise do
if DEBUG then do
say 'Found otherwise in BldDecodeStr for :'parts.i Files.filesptr
end
signal BldDecodeStrEnd
end
End
BldDecodeStrEnd:
Return
/**************************************************************************/
/* */
/* Handle the UU encoded decoding. */
/* */
/**************************************************************************/
DecodeUUFiles:
if scanonly=yes then signal DecodeUUFilesEnd
UUcmdx=UUcmd /* copy for replacement */
do j=1 to words(UUcmdx)
select
when upper(word(UUcmdx,j))='%SF' then do
wptr=wordindex(UUcmdx,j)-1
UUcmdx=delword(UUcmdx,j,1)
UUcmdx=insert(filein,UUcmdx,wptr,length(filein)+1,' ')
end
when upper(word(UUcmdx,j))='%DF' then do
wptr=wordindex(UUcmdx,j)-1
UUcmdx=delword(UUcmdx,j,1)
destfile=dest||partname
UUcmdx=insert(destfile,UUcmdx,wptr,length(destfile)+1,' ')
end
when upper(word(UUcmdx,j))='%SD' then do
wptr=wordindex(UUcmdx,j)-1
UUcmdx=delword(UUcmdx,j,1)
UUcmdx=insert(source,UUcmdx,wptr,length(source)+1,' ')
end
when upper(word(UUcmdx,j))='%DD' then do
wptr=wordindex(UUcmdx,j)-1
UUcmdx=delword(UUcmdx,j,1)
UUcmdx=insert(dest,UUcmdx,wptr,length(dest)+1,' ')
end
otherwise nop
end
end
Address Command UUcmdx
decrc=rc
if decrc >= UUcmdFail then do /* should be a CATASTROPHIC ERROR */
say '***** FATAL ERROR LEVEL for 'partname 'from file(s)' filestr
say '***** exiting ....'
signal Cleanup /* QUIT - DO NOT CONTINUE */
end
if decrc>0 then do
msg='*** Decode returned rc='decrc 'for 'partname 'from file(s)' filestr
interpret SayCmd
Miscinfo.Filesptr.pptr.1=NO /* DECODE had errors */
end
UUOutCnt=UUOutCnt+1
Call FileNoteOut
if chopflag=YES then do /* delete ALL chopped inputs always*/
Address Command 'Delete ' filein 'QUIET'
end
DecodeUUFilesEnd:
Return
/**************************************************************************/
/* */
/* Handle the Base64 encoded decoding. */
/* */
/**************************************************************************/
Decode64Files:
if scanonly=yes then signal Decode64FilesEnd
B64cmdx=Base64cmd /* copy for replacement */
do j=1 to words(B64cmdx)
select
when upper(word(B64cmdx,j))='%SF' then do
wptr=wordindex(B64cmdx,j)-1
B64cmdx=delword(B64cmdx,j,1)
B64cmdx=insert(filein,B64cmdx,wptr,length(filein)+1,' ')
end
when upper(word(B64cmdx,j))='%DF' then do
wptr=wordindex(B64cmdx,j)-1
B64cmdx=delword(B64cmdx,j,1)
destfile='"'||dest||partname||'"'
B64cmdx=insert(destfile,B64cmdx,wptr,length(destfile)+1,' ')
end
when upper(word(B64cmdx,j))='%SD' then do
wptr=wordindex(B64cmdx,j)-1
B64cmdx=delword(B64cmdx,j,1)
B64cmdx=insert(source,B64cmdx,wptr,length(source)+1,' ')
end
when upper(word(B64cmdx,j))='%DD' then do
wptr=wordindex(B64cmdx,j)-1
B64cmdx=delword(B64cmdx,j,1)
B64cmdx=insert(dest,B64cmdx,wptr,length(dest)+1,' ')
end
otherwise nop
end
end
Address Command B64cmdx
decrc=rc
if decrc>=B64cmdFail then do
say '***** FATAL ERROR LEVEL for 'partname 'from file(s)' filestr
say '***** exiting ....'
signal Cleanup /* QUIT - DO NOT CONTINUE */
end
if decrc>0 then do
msg='*** Decode returned rc='decrc 'for 'partname 'from file(s)' filestr
interpret SayCmd
Miscinfo.Filesptr.pptr.1=NO /* DECODE had errors */
end
B64OutCnt=B64OutCnt+1
Call FileNoteOut
if chopflag=YES then do /* delete ALL chopped inputs always*/
Address Command 'Delete ' filein 'QUIET'
end
Decode64FilesEnd:
Return
/**************************************************************************/
/* */
/* Handle the BinHex encoded decoding. !!! Added */
/* */
/**************************************************************************/
DecodeBHFiles:
if scanonly=yes then signal DecodeBHFilesEnd
Bincmdx=BinHexCmd /* copy for replacement */
sfpos=pos('%SF',upper(Bincmdx))
do while sfpos>0
Bincmdx=delstr(Bincmdx,sfpos,3)
Bincmdx=insert(filein,Bincmdx,sfpos-1,length(filein),' ')
sfpos=pos('%SF',upper(Bincmdx))
end
dfpos=pos('%DF',upper(Bincmdx))
do while dfpos>0
Bincmdx=delstr(Bincmdx,dfpos,3)
destfile=dest||partname
Bincmdx=insert(destfile,Bincmdx,dfpos-1,length(destfile),' ')
dfpos=pos('%DF',upper(Bincmdx))
end
sdpos=pos('%SD',upper(Bincmdx))
do while sdpos>0
Bincmdx=delstr(Bincmdx,sdpos,3)
Bincmdx=insert(source,Bincmdx,sdpos-1,length(source),' ')
sdpos=pos('%SD',upper(Bincmdx))
end
ddpos=pos('%DD',upper(Bincmdx))
do while ddpos>0
Bincmdx=delstr(Bincmdx,ddpos,3)
Bincmdx=insert(dest,Bincmdx,ddpos-1,length(dest),' ')
ddpos=pos('%DD',upper(Bincmdx))
end
Address Command Bincmdx
decrc=rc
if decrc>=BinCmdFail then do
say '***** FATAL ERROR LEVEL for 'partname 'from file(s)' filestr
say '***** exiting ....'
signal Cleanup /* QUIT - DO NOT CONTINUE */
end
if decrc>0 then do
msg='*** Decode returned rc='decrc 'for 'partname 'from file(s)' filestr
interpret SayCmd
Miscinfo.Filesptr.pptr.1=NO /* DECODE had errors */
end
BinOutCnt=BinOutCnt+1
Call FileNoteOut
if chopflag=YES then do /* delete ALL chopped inputs always*/
Address Command 'Delete ' filein 'QUIET'
end
DecodeBHFilesEnd:
Return
/**************************************************************************/
/* */
/* Chop Multi files into pieces for decoding. Use startlines found prev.*/
/* */
/**************************************************************************/
ChopFile:
goodopen=open('IN',filein,'R')
if ~goodopen then do
msg='(E) Error opening 'filein 'for chopping '
interpret Saycmd
end
start=1 /* start with line 1 */
do j=1 to Files.filesptr.1.0 /* loop thru partnames */
If Debug then say 'Chopping ' Files.filesptr ' into ' Files.filesptr.1.0 ' pieces'
Miscinfo.Filesptr.j.1.1.1=YES /* indicate file is chopped */
if j=1 then start=1 /* first entry */
else start=Files.filesptr.1.j.1.1.1
if start=missing then do
say 'Startline for ' Files.filesptr Files.filesptr.1.j 'is invalid ... exiting'
exit
end
next=j+1
if j=Files.filesptr.1.0 then stop=999999 /* last entry - no next */
else do
stop=Files.filesptr.1.next.1.1.1
if stop=missing then do
say 'Stopline for ' Files.filesptr Files.filesptr.1.next 'is invalid ... exiting'
exit
end
stop=stop-1
end
if Miscinfo.Filesptr.j.1.1.1.1=missing then do
fileout=DWtemp||Files.filesptr||'.'||j /* build chopped name */
goodopen=open('OUT',fileout,'W')
if ~goodopen then do
msg='(E) Error opening 'fileout
interpret Saycmd
end
end
If Debug then say ' Writing ... ' START STOP fileout
do k=start to stop /* read/write lines out */
linein=readln('IN')
if ~eof('IN') then do
if Miscinfo.Filesptr.j.1.1.1.1=missing then do
result=writeln('OUT',linein)
end
end
else do
k=stop /* EOF - quit looping */
end
end
if Miscinfo.Filesptr.j.1.1.1.1=missing then do
result=close('OUT') /* close output file */
end
end
result=close('IN')
Return
/**************************************************************************/
/* */
/* Report Decoding operations. */
/* */
/**************************************************************************/
IssueDecodeMsg:
msg=overlay(filestr,msg,length(msg)+3)
if ShowDecode then interpret SayCmd
Return
/**************************************************************************/
/* */
/* Filenote output files as specified. */
/* */
/* Handle escaping Amiga Special Characters. This requires an apostrophe */
/* to be placed before #,%,? in filenames. */
/* */
/**************************************************************************/
FileNoteOut:
foundspec=pos("'",partname)
do while foundspec > 0
part1=substr(partname,1,foundspec-1)
part2=substr(partname,foundspec+1)
partname=part1||"''"||part2
foundspec=pos("'",part2)
if foundspec>0 then foundspec=foundspec+length(part1)+2
end
foundspec=pos("%",partname)
do while foundspec > 0
part1=substr(partname,1,foundspec-1)
part2=substr(partname,foundspec+1)
partname=part1||"''%"||part2
foundspec=pos("%",part2)
if foundspec>0 then foundspec=foundspec+length(part1)+3
end
foundspec=pos("#",partname)
do while foundspec > 0
part1=substr(partname,1,foundspec-1)
part2=substr(partname,foundspec+1)
partname=part1||"''#"||part2
foundspec=pos("#",part2)
if foundspec>0 then foundspec=foundspec+length(part1)+3
end
foundspec=pos("?",partname)
do while foundspec > 0
part1=substr(partname,1,foundspec-1)
part2=substr(partname,foundspec+1)
partname=part1||"''?"||part2
foundspec=pos("?",part2)
if foundspec>0 then foundspec=foundspec+length(part1)+3
end
foundspec=pos("~",partname)
do while foundspec > 0
part1=substr(partname,1,foundspec-1)
part2=substr(partname,foundspec+1)
partname=part1||"''~"||part2
foundspec=pos("~",part2)
if foundspec>0 then foundspec=foundspec+length(part1)+3
end
foundspec=pos("(",partname)
do while foundspec > 0
part1=substr(partname,1,foundspec-1)
part2=substr(partname,foundspec+1)
partname=part1||"''("||part2
foundspec=pos("(",part2)
if foundspec>0 then foundspec=foundspec+length(part1)+3
end
foundspec=pos(")",partname)
do while foundspec > 0
part1=substr(partname,1,foundspec-1)
part2=substr(partname,foundspec+1)
partname=part1||"'')"||part2
foundspec=pos(")",part2)
if foundspec>0 then foundspec=foundspec+length(part1)+3
end
if filenote~='' & Miscinfo.Filesptr.pptr.1.1=missing then do
interpret intfnote fnote
fnotex=substr(fnotex,1,79)
fncmd="Address Command 'Filenote "||'"'||partname||'" "'||fnotex||'"'||" '"
interpret fncmd
fnrc=rc
if fnrc>0 then do
msg='*** Filenote returned rc='fnrc 'for 'partname
interpret SayCmd
end
Miscinfo.Filesptr.pptr.1.1=YES /* mark as filenoted */
end
Return
/**************************************************************************/
/* */
/* Issue any Warning messages we may have */
/* */
/**************************************************************************/
IssueWarnings:
if warnings.0>0 then do
msg=' '
interpret Saycmd
end
do j=1 to warnings.0
msg=warnings.j
interpret Saycmd
end
Return
/**************************************************************************/
/* */
/* Convert Date: line in header to timestamp */
/* */
/**************************************************************************/
TimeStamp:
datemsg=upper(datemsg) /* upper case it */
if pos(',',datemsg)>0 then datemsg=substr(datemsg,pos(',',datemsg)+1)
datemsg=strip(datemsg)
Call CalcDays
Return
/**************************************************************************/
/* */
/* Calculate a value for year+month+day */
/* */
/**************************************************************************/
CalcDays:
leap=0 /* assume not a leap year */
year=word(datemsg,3) /* year portion of msg */
if year<100 then do /* fix 2 digit years */
sdate=date('S') /* yyyymmdd */
year=left(sdate,4) /* get just the yyyy part */
end
month=word(datemsg,2) /* month portion of msg */
day=word(datemsg,1) /* day portion of msg */
time=word(datemsg,4) /* time portion of msg */
offset=word(datemsg,5) /* offset from GMT */
parse var time hour ':' min ':' second /* get time pieces */
Select
when month='JAN' then month=0
when month='FEB' then do /* not worth the cycles for 2100AD */
month=31
if year//4=0 then leap=1
end
when month='MAR' then month=59+leap
when month='APR' then month=90+leap
when month='MAY' then month=120+leap
when month='JUN' then month=151+leap
when month='JUL' then month=181+leap
when month='AUG' then month=212+leap
when month='SEP' then month=243+leap
when month='OCT' then month=273+leap
when month='NOV' then month=304+leap
when month='DEC' then month=334+leap
otherwise do
msg=' '
interpret Saycmd
msg='Date Error processing file' Files.i
interpret Saycmd
msg=' ' datemsg
interpret Saycmd
end
end
days=day+month+(year*365)
Return
/**************************************************************************/
/* */
/* Do all of the basic initialization stuff. */
/* */
/**************************************************************************/
Init:
Call ChangeDir /* Change to PROGDIR: */
Call InternalDefaults /* init internal default values */
Call CmdOverrides /* load and test cmd line options */
Call ReadPrefs /* load and test PrefsFile options */
Call SetParms /* set values based on final options */
Call LoadSecTab /* load Section: identifier info */
Call LoadBase64Types /* load B64 start line indicators */
Call LoadBinTypes /* load binary types to handle */
Call LoadEncTypes /* load MIME encoding information */
Call EnsureLibs /* add necessary libs if needed */
if SkipFrom | DeleteFrom then Call LoadSkipFroms /* load table */
if SkipSubject | DeleteSubject then Call LoadSkipSubjects
if (DumpOpts | Debug) then Call DumpOpts /* wants options list on rpt */
if Recursive then do /* Recursive=YES option */
Call Getdirs /* get directories */
end
if (ShowDirs | Debug) then Call DumpDirs /* wants dir listing on rpt */
if verbose then do
if show('L','rexxtricks.library') then do /* using trics library */
say time() 'Using rexxtricks.library ...'
end
else do
say time() 'Using QuickSort ...'
end
end
Return
/**************************************************************************/
/* */
/* Change directory to that of this program. Ensures that we find */
/* all of the files we need */
/* */
/**************************************************************************/
ChangeDir:
Parse UPPER source invoked results called rest
rest=subword(rest,1,words(rest)-2)
slpos=lastpos('/',rest)
copos=pos(':',rest)
progdir=strip(substr(rest,1,max(slpos,copos)-1))
origdir=pragma('D',progdir)
Return
/**************************************************************************/
/* */
/* These values are hard coded and can't be overridden */
/* */
/**************************************************************************/
InternalDefaults:
YES=1 /* a few useful values */
TRUE=1 /* a few useful values */
ON=1 /* a few useful values */
NO=0 /* a few useful values */
FALSE=0 /* a few useful values */
OFF=0 /* a few useful values */
DONE=0 /* a few useful values */
cr='0D'x /* carriage return */
tab='09'x /* tab character value */
dashes=copies('-',72) /* dashed line for report divisions */
missing='.' /* var for array init */
infolines=18 /* top lines of this program used for intro */
delaymsg.0=infolines /* startup lines - delayed */
do i=1 to infolines
delaymsg.i=sourceline(i)
end
intfnote='fnotex=' /* used for creating output filenotes */
SayCmd='Say msg' /* write messages to console not Log */
/**************************************************************************/
/* */
/* These values are used if not overridden by the Prefs file */
/* or as command line arguments. */
/* */
/**************************************************************************/
int.0=65
int.1 ='B64cmdFail BF N 20'
int.2 ='Base64Cmd BC F Base64Decode %SF %DF USEMINLEN > nil:'
int.3 ='Base64TypesFile B64F F DWdecode.Base64.Types'
int.4 ='BinCmdFail BHF N 20'
int.5 ='BinHexCmd BHC F BHD data=%DF %SF'
int.6 ='BinTypesFile BTF F DWdecode.Binary.Types'
int.7 ='Debug DB B NO'
int.8 ='DeleteAfter DELA B NO'
int.9 ='DeleteDups DELD B NO'
int.10='DeleteFrom DELF B NO'
int.11='DeleteOld DELO B NO'
int.12='DeleteSubject DELS B NO'
int.13='DeleteText DELT B NO'
int.14='Dest D F . '
int.15='DumpBase64Types D64T B NO'
int.16='DumpBinTypes DBT B NO'
int.17='DumpDates DD B NO'
int.18='DumpEncTypes DET B NO'
int.19='DumpFiles DF B NO'
int.20='DumpFroms DFR B NO'
int.21='DumpMisc DM B NO'
int.22='DumpOpts DO B NO'
int.23='DumpPhase2 DP2 B NO'
int.24='DumpSectionTypes DST B NO'
int.25='DumpSkipFroms DSF B NO'
int.26='DumpSkipSubjects DSS B NO'
int.27='DumpSubjects DS B NO'
int.28='DWassignIN DWI S DW:'
int.29='DWtemp DWT F T:'
int.30='EncTypesFile ETF F DWdecode.Encode.Types'
int.31='FileNote FN S %LLQ2 : %SUBJECT'
int.32='KeepDays KD N 30'
int.33='Log L B YES'
int.34='LogFile LF S DWdecode.Log'
int.35='MarkOld MO B YES'
int.36='MaxHeader MH N 25'
int.37='MinEncoded ME N 4'
int.38='PrefsFile P F DWdecode.Prefs'
int.39='Quiet Q B NO'
int.40='Recursive REC B YES'
int.41='Replace REP B NO'
int.42='RunBack RB S run > nil:'
int.43='ScanOnly SO B NO'
int.44='ScanProg SP F FlashFind'
int.45='SectionTypesFile STF F DWdecode.Section.Types'
int.46='ShowDecode SHDE B YES'
int.47='ShowDirs SHDI B YES'
int.48='ShowFiles SHF B YES'
int.49='ShowParts SHP B YES'
int.50='ShowStats SHS B YES'
int.51='SkipFrom SF B YES'
int.52='SkipFromFile SFF F DWdecode.Skip.Froms'
int.53='SkipSubject SS B YES'
int.54='SkipSubjectFile SSF F DWdecode.Skip.Subjects'
int.55='Source S F . '
int.56='TrapAllBegs TAB B NO'
int.57='TrapAllEncs TAE B NO'
int.58='TrapAllSecs TAS B NO'
int.59='TrapNewEncs TNE B YES'
int.60='TrapNewEncsFile TNEF S DWdecode.Trap.Encodes'
int.61='TrapNewSecs TNS B YES'
int.62='TrapNewSecsFile TNSF S DWdecode.Trap.Sections'
int.63='UUcmd UC F UUout %SF BUFSIZE=150 IGNORETERMINATION USEBASENAME > nil:'
int.64='UUcmdFail UF N 10'
int.65='XDELETE XD B NO'
cmd.0=int.0 /* duplicate number of entires */
do i=1 to int.0 /* loop through them */
cmd.i =word(int.i,1) /* variable name in program */
cmd.i.1 =word(int.i,2) /* an alias for variable name */
cmd.i.1.1=word(int.i,3) /* type of variable B,S,T,F,N */
cmd.i.1.1.1=subword(int.i,4) /* default for the variable */
if cmd.i.1.1='N' | cmd.i.1.1='B' then cmdstr=cmd.i||"="||cmd.i.1.1.1
else cmdstr=cmd.i||"='"||cmd.i.1.1.1||"'" /* build variable assign */
interpret cmdstr /* do it */
end
drop int. /* done with this array */
Return
/**************************************************************************/
/* */
/* See what values are specified on the command line. */
/* These will override the values in the default file. */
/* */
/**************************************************************************/
/* Load all arguments that have '=' signs in them. Parse strings based on */
/* assuming a beginning quote (either type) and locating the ending one. */
/* After deleting ALL xxx=yyy type pieces, the remaining ones SHOULD be */
/* boolean switches. All of the commands will be tested based upon the */
/* type value in the cmd. array. Strings can be anything; Files must */
/* already exist; Booleans must be 1/0, YES/NO, ON/OFF; and Numerics must */
/* be numeric. Any that don't match a valid command or its alias are */
/* reported as errors and we exit after all have been processed. */
/* */
/**************************************************************************/
/* If help requested then display internal defaults and exit. */
/**************************************************************************/
CmdOverrides:
if commandline='?' | upper(commandline)='-H' | upper(commandline)='HELP' then do
do i=1 to delaymsg.0
msg=delaymsg.i
interpret Saycmd
end
msg=' '
interpret Saycmd
msg='Command-Option Alias Internal Value'
interpret Saycmd
msg=left(dashes,78)
interpret Saycmd
do i=1 to cmd.0
msg=cmd.i
msg=overlay(cmd.i.1,msg,18)
msg=overlay(cmd.i.1.1.1,msg,25)
interpret Saycmd
end
msg=' '
interpret Saycmd
msg='See DWDecode.doc or DWDecode.guide for complete description of options'
interpret Saycmd
signal cleanup
end
say ' '
say time() 'Determining runtime options ...'
cmdopt.=missing
cmdopt.0=0
eqpos=pos('=',commandline)
i=0
quitflag=NO
do while eqpos~=0
cmdpart1=strip(substr(commandline,1,eqpos-1))
cmdpart2=strip(substr(commandline,eqpos+1))
i=i+1
cmdopt.0=i
cmdopt.i=word(cmdpart1,words(cmdpart1))
cmdpart1=subword(cmdpart1,1,words(cmdpart1)-1)
select
when substr(cmdpart2,1,1)='"' then do
endquote=pos('"',cmdpart2,2)
if endquote=0 then do
delaymsg.0=delaymsg.0 + 1
dx=delaymsg.0
delaymsg.dx='(E) Missing ending quote for: ' cmdopt.i
quitflag=YES
end
cmdopt.i.1=substr(cmdpart2,2,endquote-2)
cmdpart2=substr(cmdpart2,endquote+1)
end
when substr(cmdpart2,1,1)="'" then do
endquote=pos("'",cmdpart2,2)
if endquote=0 then do
delaymsg.0=delaymsg.0 + 1
dx=delaymsg.0
delaymsg.dx='(E) Missing ending quote for: ' cmdopt.i
quitflag=YES
end
cmdopt.i.1=substr(cmdpart2,2,endquote-2)
cmdpart2=substr(cmdpart2,endquote+1)
end
otherwise do
cmdopt.i.1=word(cmdpart2,1)
cmdpart2=subword(cmdpart2,2)
end
end
commandline=cmdpart1||' '||cmdpart2
eqpos=pos('=',commandline)
end
do j=1 to words(commandline)
i=i+1
cmdopt.0=i
cmdopt.i=word(commandline,1)
commandline=subword(commandline,2)
end
do i=1 to cmdopt.0
matchflag=NO
do j=1 to cmd.0
UPO=upper(cmdopt.i)
UPV=upper(cmdopt.i.1)
UPC=upper(cmd.j)
UPA=upper(cmd.j.1)
UPT=upper(cmd.j.1.1)
if UPO=UPC | UPO=UPA then do
matchflag=YES
select
when UPT='B' then do
select
when UPV=missing then cmdopt.i.1='YES'
when UPV='YES' then nop
when UPV='ON' then nop
when UPV='TRUE' then nop
when UPV='1' then nop
when UPV='NO' then nop
when UPV='OFF' then nop
when UPV='FALSE' then nop
when UPV='0' then nop
otherwise do
delaymsg.0=delaymsg.0 + 1
dx=delaymsg.0
delaymsg.dx='(E) Invalid value for 'UPC 'must be YES/NO'
quitflag=YES
end
end
end
when UPT='N' then do
if verify(UPV,'0123456789')~=0 then do
say '(E) Invalid value for 'UPC 'must be numeric'
quitflag=YES
end
end
otherwise nop
end
cmdopt.i=cmd.j /* store real variable name */
cmdopt.i.1.1=cmd.j.1.1 /* store variable type */
leave j
end
end
if ~matchflag then do
delaymsg.0=delaymsg.0 + 1
dx=delaymsg.0
delaymsg.dx='(E) Unrecognized argument: 'UPO'. See Documentation.'
quitflag=YES
end
end
/**************************************************************************/
/* Set values from command line, will have to do it again, after values */
/* are set from PrefsFile. Makes it easier to use cmdline options early. */
/**************************************************************************/
do i=1 to cmdopt.0 /* loop through them */
if cmdopt.i.1.1='N' | cmdopt.i.1.1='B' then cmdstr=cmdopt.i||"="||cmdopt.i.1
else cmdstr=cmdopt.i||"='"||cmdopt.i.1||"'" /* build var assign */
interpret cmdstr /* do it */
end
Return
/**************************************************************************/
/* */
/* Read in the information from the Prefs file */
/* */
/**************************************************************************/
ReadPrefs:
pcmd.=missing
i=0
goodopen=open('Prefs',PrefsFile,'R')
if ~goodopen then do
delaymsg.0=delaymsg.0 + 1
dx=delaymsg.0
delaymsg.dx='(W) Prefs file not found - using command options & internal values'
end
else do
delaymsg.0=delaymsg.0 + 1
dx=delaymsg.0
delaymsg.dx='Using PrefsFile: ' PrefsFile
do until eof('Prefs')
default=readln('Prefs')
if default~=' ' & default~='#' & default~='' then do
if pos('#',default)~=1 then do
if pos('#',default)>2 then do
default=substr(default,1,pos('#',default)-1)
end
default=strip(default)
select
when pos('=',default)>0 then do
i=i+1
pcmd.i=substr(default,1,pos('=',default)-1)
pval=substr(default,pos('=',default)+1)
pval=strip(pval,'B',"'")
pval=strip(pval,'B','"')
pcmd.i.1=pval
end
when words(default)=1 then do
i=i+1
pcmd.i=default
pcmd.i.1='YES'
end
otherwise do
delaymsg.0=1+delaymsg.0
dx=delaymsg.0
delaymsg.dx='(E) Missing "=" in PrefsFile line: 'default
quitflag=YES
end
end
end
end
end
end
result=close('Prefs')
pcmd.0=i /* number of PrefsFile options */
/**************************************************************************/
/* Validate options set in the Preferences file. */
/**************************************************************************/
do i=1 to pcmd.0
matchflag=NO
do j=1 to cmd.0
UPO=upper(pcmd.i)
UPV=upper(pcmd.i.1)
UPC=upper(cmd.j)
UPA=upper(cmd.j.1)
UPT=upper(cmd.j.1.1)
if UPO=UPC | UPO=UPA then do
matchflag=YES
select
when UPT='B' then do
select
when UPV=missing then pcmd.i.1='YES'
when UPV='YES' then nop
when UPV='ON' then nop
when UPV='TRUE' then nop
when UPV='1' then nop
when UPV='NO' then nop
when UPV='OFF' then nop
when UPV='FALSE' then nop
when UPV='0' then nop
otherwise do
delaymsg.0=delaymsg.0 + 1
dx=delaymsg.0
delaymsg.dx='(E) Invalid value for 'UPC 'must be YES/NO'
quitflag=YES
end
end
end
when UPT='N' then do
if verify(UPV,'0123456789')~=0 then do
say '(E) Invalid value for 'UPC 'must be numeric'
quitflag=YES
end
end
otherwise nop
end
pcmd.i=cmd.j /* store real variable name */
pcmd.i.1.1=cmd.j.1.1 /* store variable type */
leave j
end
end
if ~matchflag then do
delaymsg.0=delaymsg.0 + 1
dx=delaymsg.0
delaymsg.dx='(E) Unrecognized argument: 'UPO'. See Documentation.'
quitflag=YES
end
end
do i=1 to pcmd.0 /* loop through them */
if pcmd.i.1.1='N' | pcmd.i.1.1='B' then cmdstr=pcmd.i||"="||pcmd.i.1
else cmdstr=pcmd.i||"='"||pcmd.i.1||"'" /* build variable assign */
interpret cmdstr /* do it */
end
drop pcmd. /* done with this array */
/**************************************************************************/
/* Set values from command line for final time. */
/**************************************************************************/
do i=1 to cmdopt.0 /* loop through them */
if cmdopt.i.1.1='N' | cmdopt.i.1.1='B' then cmdstr=cmdopt.i||"="||cmdopt.i.1
else cmdstr=cmdopt.i||"='"||cmdopt.i.1||"'" /* build var assign */
interpret cmdstr /* do it */
end
drop cmdopt. /* done with this array */
if DEBUG=YES then QUIET=NO /* turn on all messages */
if QUIET=NO then VERBOSE=YES /* Make into a positive remark */
else VERBOSE=NO
if verbose then say time() 'Verifying existence of files ...'
do i=1 to cmd.0 /* loop thru validating files */
if cmd.i.1.1='F' then do
tstr='tfile=word('||cmd.i||',1)'
interpret tstr
if ~exists(tfile) then do
delaymsg.0=delaymsg.0 + 1
dx=delaymsg.0
delaymsg.dx='(E) File' tfile 'does not exist '
quitflag=YES
end
end
end
if Log=YES then do
Saycmd="result=writeln('LOG',msg)"
goodopen=open('LOG',logfile,'W')
if ~goodopen then do
delaymsg.0=1+delaymsg.0
dx=delaymsg.0
delaymsg.dx='(E) Unable to open logfile:' logfile
delaymsg.0=1+delaymsg.0
dx=delaymsg.0
delaymsg.dx='Continuing without logfile. Messages displaying on console'
SayCmd='Say msg'
end
end
do i=1 to delaymsg.0
msg=delaymsg.i
interpret Saycmd
end
drop delaymsg. /* done with this array */
if quitflag then do /* command/prefs error(s) */
if Log=YES then do
Say ' '
Say 'Unable to continue: See 'logfile 'for additional messages'
end
exit 20
end
Return
/**************************************************************************/
/* */
/* Adjust options based on final values of variables */
/* */
/**************************************************************************/
SetParms:
if Source='' then do
msg='(E) SOURCE directory is a REQUIRED parameter. See documentation.'
interpret Saycmd
exit
end
if Dest='' then do
msg='(E) DEST directory is a REQUIRED parameter. See documentation.'
interpret Saycmd
exit
end
dircnt=1 /* next directory to process */
dirlist.0=1 /* one directory for now */
if right(dest,1)~='/' & right(dest,1)~=':' then dest=dest||'/'
if right(source,1)~='/' & right(source,1)~=':' then source=source||'/'
dirlist.1=source /* the original source directory */
if MarkOld | DeleteOld then do /* need a value for today */
datemsg= date() ' ' time() ' +900' /* build a fake Date: */
datemsg=upper(datemsg) /* force to upper for rtn */
Call CalcDays
today=days
if KeepDays<1 then do
msg='(W) KeepDays less than 1. Forcing to KEEPDAYS=30'
interpret Saycmd
KeepDays=30
end
end
if XDELETE then do /* turn on ALL delete opts */
DeleteAfter =YES
DeleteDups =YES
DeleteFrom =YES
DeleteOld =YES
DeleteSubject =YES
DeleteText =YES
end
Return
/**************************************************************************/
/* */
/* Load SECTION table */
/* */
/* Load tables for parsing partname, partnum information from external */
/* tables. Descriptions are in each and each is required. */
/* */
/**************************************************************************/
LoadSecTab:
goodopen=open('SecTables',SectionTypesFile,'R')
if ~goodopen then do
msg='(E) Required file ('SectionTypesFile') not found. See documentation.'
interpret Saycmd
exit
end
msg='Using Section Types File:' SectionTypesFile
if ~DEBUG & ~DUMPOPTS then interpret Saycmd
i=0 /* array pointer */
do until eof('SecTables')
SecTable=readln('SecTables')
if SecTable~=' ' & SecTable~='#' & SecTable~='' then do
if pos('#',SecTable) ~= 1 then do
if pos('#',SecTable)>1 then do
SecTable=substr(SecTable,1,pos('#',SecTable)-1)
end
SecTable=strip(SecTable)
i=i+1 /* bump array pointer */
j=word(SecTable,1) /* number of keys present*/
Sectiontypes.i=j /* load array with value */
l=2 /* first key portion */
do k=1 to j /* loop thru pairs */
Sectiontypes.i.k=word(SecTable,l) /* key portion */
Sectiontypes.i.k.k=word(SecTable,l+1) /* key location */
l=l+2 /* set to next pair */
end
Sectiontypes.i.1.1.1=word(SecTable,l) /* part number */
Sectiontypes.i.1.1.1.1=word(SecTable,l+1) /* total parts */
Sectiontypes.i.1.1.1.1.1=word(SecTable,l+2) /* filename */
Sectiontypes.i.1.1.1.1.1.1=word(SecTable,l+3) /* sep. char. */
end
end
end
Sectiontypes.0=i /* num in section table */
result=close('SecTables')
Return
/**************************************************************************/
/* */
/* Get the different start line indicators for Base64 files. */
/* */
/**************************************************************************/
LoadBase64Types:
goodopen=open('Base64Types',Base64TypesFile,'R')
if ~goodopen then do
msg='(E) Required file ('Base64TypesFile') not found. See documentation.'
interpret Saycmd
exit
end
msg='Using Base64 Types File: ' Base64TypesFile
if ~DEBUG & ~DUMPOPTS then interpret Saycmd
i=0
do until eof('Base64Types')
Base64type=readln('Base64Types')
Base64type=strip(Base64type)
if substr(Base64type,1,1)='#' | Base64type='' | Base64type=' ' then nop
else do
if pos('#',Base64type)>1 then do
Base64type=substr(Base64type,1,pos('#',Base64type)-1)
Base64type=strip(Base64type)
end
i=i+1
Base64Types.i=Base64Type
end
end
Base64Types.0=i
result=close('Base64Types')
Return
/**************************************************************************/
/* */
/* Get the types of file extensions we're to try to handle */
/* */
/**************************************************************************/
LoadBinTypes:
goodopen=open('BinTypes',BinTypesFile,'R')
if ~goodopen then do
msg='(E) Required file ('BinTypesFile') not found. See documentation.'
interpret Saycmd
exit
end
msg='Using Binary Types File: ' BinTypesFile
if ~DEBUG & ~DUMPOPTS then interpret Saycmd
i=0
do until eof('BinTypes')
bintype=readln('BinTypes')
bintype=strip(bintype)
if substr(bintype,1,1)='#' | bintype='' | bintype=' ' then nop
else do
if pos('#',bintype)>1 then do
bintype=substr(bintype,1,pos('#',bintype)-1)
bintype=strip(bintype)
end
i=i+1
Bintypes.i=upper(bintype)
end
end
Bintypes.0=i
result=close('BinTypes')
Return
/**************************************************************************/
/* */
/* Get the MIME encoding types that are known and which they are */
/* */
/**************************************************************************/
LoadEncTypes:
goodopen=open('EncTypes',EncTypesFile,'R')
if ~goodopen then do
msg='(E) Required file ('EncTypesFile') not found. See documentation.'
interpret Saycmd
exit
end
msg='Using Encode Types File: ' EncTypesFile
if ~DEBUG & ~DUMPOPTS then interpret Saycmd
i=0
do until eof('EncTypes')
enctype=readln('EncTypes')
enctype=strip(enctype)
if substr(enctype,1,1)='#' | enctype='' | enctype=' ' then nop
else do
if pos('#',enctype)>1 then do
enctype=substr(enctype,1,pos('#',enctype)-1)
enctype=strip(enctype)
end
i=i+1
Enctypes.i=upper(word(enctype,1))
if words(enctype)>1 then Enctypes.i.1=upper(word(enctype,2))
else Enctypes.i.1=missing
end
end
Enctypes.0=i
result=close('EncTypes')
Return
/**************************************************************************/
/* */
/* Load list of users in From: lines to SKIP */
/* */
/**************************************************************************/
LoadSkipFroms:
goodopen=open('SkipFroms',SkipFromFile,'R')
if ~goodopen then do
msg=' '
interpret Saycmd
msg='(E) Unable to open SkipFromFile "'SkipFromFile'"'
interpret Saycmd
msg=' Setting DELETEFROM=NO SKIPFROM=NO DUMPSKIPFROMS=NO'
interpret Saycmd
SkipFrom=NO
DeleteFrom=NO
DumpSkipFroms=NO
end
else do
msg='Using SkipFromFile: ' SkipFromFile
if ~DEBUG & ~DUMPOPTS then interpret Saycmd
end
i=0
if goodopen then do until eof('SkipFroms')
skipuser=readln('SkipFroms')
skipuser=strip(skipuser)
if substr(skipuser,1,1)='#' | skipuser='' | skipuser=' ' then nop
else do
i=i+1
SkipFroms.i=skipuser
end
end
SkipFroms.0=i
result=close('SkipFroms')
Return
/**************************************************************************/
/* */
/* Load list of words in Subject: lines to SKIP */
/* */
/**************************************************************************/
LoadSkipSubjects:
goodopen=open('SkipSubjects',SkipSubjectFile,'R')
if ~goodopen then do
msg=' '
interpret Saycmd
msg='(E) Unable to open SkipSubjectFile "'SkipSubjectFile'"'
interpret Saycmd
msg=' Setting DELETESUBJECT=NO SKIPSUBJECT=NO DUMPSKIPSUBJECTS=NO'
interpret Saycmd
SkipSubject=NO
DeleteSubject=NO
DumpSkipSubjects=NO
end
else do
msg='Using SkipSubjectFile: ' SkipSubjectFile
if ~DEBUG & ~DUMPOPTS then interpret Saycmd
end
i=0
if goodopen then do until eof('SkipSubjects')
skipuser=readln('SkipSubjects')
skipuser=strip(skipuser)
if substr(skipuser,1,1)='#' | skipuser='' | skipuser=' ' then nop
else do
i=i+1
SkipSubjects.i=skipuser
end
end
SkipSubjects.0=i
result=close('SkipSubjects')
Return
/**************************************************************************/
/* */
/* Make sure that we have all the libs we need: */
/* */
/* RexxSupport */
/* RexxArpLib */
/* QuickSort */
/* */
/**************************************************************************/
EnsureLibs:
goodlibs=TRUE
if ~show('L','rexxsupport.library') then do
if exists('LIBS:rexxsupport.library') then do
addlib('rexxsupport.library',0,-30)
end
else do
msg='(E) Unable to add rexxsupport.library -- check installation instructions'
interpret Saycmd
say msg
goodlibs=FALSE
end
end
if ~show('L','rexxarplib.library') then do
if exists('LIBS:rexxarplib.library') then do
addlib('rexxarplib.library',0,-30)
end
else do
msg='(E) Unable to add rexxarplib.library -- check installation instructions'
interpret Saycmd
say msg
goodlibs=FALSE
end
end
if ~show('P','QuickSortPort') then do
address command runback " quicksort"
do i = 1 to 10
if ~show('P','QuickSortPort') then call delay 20
else leave i
end
end
if show('P','QuickSortPort') then do
call addlib('QuickSortPort',-30)
end
else do
msg='(E) Unable to find QuickSort -- check installation instructions'
interpret Saycmd
say msg
goodlibs=FALSE
end
if ~goodlibs then signal Cleanup /* exit due to errors */
Return
/**************************************************************************/
/* */
/* Read Source Directory for list directories to process */
/* */
/* force '/' onto source if not present and not a volume or assign */
/* */
/**************************************************************************/
GetDirs:
tempdirs.=missing
tempdirs.0 = FILELIST(source||'*',tempdirs,"D","E")
do i=1 to tempdirs.0
dirlist.0=1+dirlist.0
dirptr=dirlist.0
dirlist.dirptr=tempdirs.i||'/'
end
dircnt=dircnt+1 /* next dir to process */
if dircnt>dirlist.0 then DONE=YES
do while ~DONE
source=dirlist.dircnt /* directory to look thru*/
call GetDirs /* Recursive Call to this same routine */
end
if show('L','rexxtricks.library') then do /* use tricks library */
say time() 'Using rexxtricks.library'
call QSORT(dirlist) /* sort into pretty order */
end
else do /* use QuickSort */
say time() 'Using QuickSort'
call QSORT(1, dirlist.0, dirlist) /* sort into pretty order */
end
Return
/**************************************************************************/
/* */
/* Various routines called for debugging/trace options */
/* */
/**************************************************************************/
DumpArrays:
if (DumpFiles | Debug) & Files.0 > 0 then call DumpFiles
if (DumpPhase2 | Debug) & Files.0 > 0 then call DumpPhase2
if (DumpMisc | Debug) & Files.0 > 0 then call DumpMiscinfo
if (DumpFroms | Debug) & Files.0 > 0 then call DumpFrominfo
if (DumpSubjects | Debug) & Files.0 > 0 then call DumpSubjinfo
if (DumpDates | Debug) & Files.0 > 0 then call DumpDateinfo
if (TrapAllBegs | Debug) & AllBegins.0 > 0 then call DumpBegins
if (TrapAllEncs | Debug) & AllEncodes.0 > 0 then call DumpEncodes
if (TrapAllSecs | Debug) & Allsections.0 > 0 then call DumpSections
/************************/
/* */
/* Dump these only once */
/* at end */
/************************/
if dirptr=dirlist.0 then do
if (DumpBinTypes | Debug) & BinTypes.0 > 0 then call DumpBinTypes
if (DumpBase64Types | Debug) & Base64Types.0 > 0 then call DumpBase64Types
if (DumpEncTypes | Debug) & EncTypes.0 > 0 then call DumpEncTypes
if (DumpSectionTypes | Debug) & SectionTypes.0 > 0 then call DumpSectionTypes
if (DumpSkipFroms | Debug) & SkipFroms.0 > 0 then call DumpSkipFroms
if (DumpSkipSubjects | Debug) & SkipSubjects.0 > 0 then call DumpSkipSubjects
end
Return
/**************************************************************************/
/* */
/* Dumps array used for directories on Recursive */
/* */
/**************************************************************************/
DumpDirs:
msg=' '
interpret Saycmd
if dirlist.0=1 then msg=dirlist.0 ' Directory found'
else msg=dirlist.0 ' Directories found'
interpret Saycmd
msg=left(dashes,length(msg))
interpret Saycmd
do j=1 to dirlist.0 /* dump dir list array */
msg=dirlist.j
interpret Saycmd
end
msg=' '
interpret Saycmd
Return
/**************************************************************************/
/* Dumps Files. array for all partnames. */
/**************************************************************************/
/* (0)=cnt (0)=cnt */
/* Files. format: filename.encodetype.partname.partnum.parttot.startline */
/* .encodetype.partname.partnum.parttot.startline */
/**************************************************************************/
DumpFiles:
msg=' '
interpret Saycmd
msg='(DUMPFILES=YES)' Files.0 ' File(s)'
interpret Saycmd
msg='Format: Subject line'
interpret saycmd
msg=' Filename Encodetype Partname Partnum Parttot Startline ("."=missing)'
interpret saycmd
msg=left(dashes,length(msg))
interpret Saycmd
do i=1 to Files.0
msg= Subjinfo.i.1.1
interpret Saycmd
msg=i Files.i.0 Files.i.1.0 Files.i.1.1.0 Files.i.1.1.1.0 Files.i.1.1.1.1.0
interpret Saycmd
if Files.i.1.0=0 then do
msg=Files.i Files.i.1 Files.i.1.1 Files.i.1.1.1 Files.i.1.1.1.1 Files.i.1.1.1.1.1
interpret Saycmd
end
else do
do j=1 to Files.i.1.0
msg=Files.i Files.i.1 Files.i.1.j Files.i.1.j.1 Files.i.1.j.1.1 Files.i.1.j.1.1.1
interpret Saycmd
end
end
msg=' '
interpret Saycmd
end
Return
/**************************************************************************/
/* Dumps Partone. & Partxxx. arrays */
/**************************************************************************/
/* (0)#partname matches in subject line */
/* (0)#partnums in subject line */
/* (0)#totals in sub */
/* Files spart spart */
/* Partone. format: Pointer.partname.sword.number.loc.total.loc.subjline */
/* */
/* Partxxx.=same format as Partone. */
/* */
**************************************************************************/
DumpPhase2:
msg=' '
interpret Saycmd
msg='(DUMPPHASE2=YES) Dumping Partone array: ("."=missing)'
interpret Saycmd
msg='Format: Subject-line'
interpret Saycmd
msg=' Files spart spart'
interpret saycmd
msg=' Pointer partname sword number loc total loc'
interpret Saycmd
msg=left(dashes,length(msg))
interpret Saycmd
do j=1 to Partone.0
msg=' '
interpret Saycmd
msg=Partone.j.1.1.1.1.1.1.1 /* subjline */
interpret Saycmd
msg=Partone.j Partone.j.0 Partone.j.1.0 Partone.j.1.1.0 Partone.j.1.1.1.0 Partone.j.1.1.1.1.0 Partone.j.1.1.1.1.1.0 Partone.j.1.1.1.1.1.1.0
interpret Saycmd
if datatype(Partone.j.1.0,'N') & datatype(Partone.j.1.1.0,'N') & datatype(Partone.j.1.1.1.1.0,'N') then do
kmax=max(Partone.j.1.0,Partone.j.1.1.0,Partone.j.1.1.1.1.0)
end
else kmax=3 /* assume max of 3 */
do k=1 to kmax /* max depth of loops */
msg=Partone.j Partone.j.1
msg=msg||' '||Partone.j.1.k
msg=msg||' '||Partone.j.1.1.k
msg=msg||' '||Partone.j.1.1.k.1
msg=msg||' '||Partone.j.1.1.1.1.k
msg=msg||' '||Partone.j.1.1.1.1.k.1
interpret Saycmd
end
end
msg=' '
interpret Saycmd
msg=' '
interpret Saycmd
msg='(DUMPPHASE2=YES) Dumping Partxxx array: ("."=missing)'
interpret Saycmd
msg='Format: Subject-line'
interpret Saycmd
msg=' Files spart spart'
interpret saycmd
msg=' Pointer partname sword number loc total loc'
interpret Saycmd
msg=left(dashes,length(msg))
interpret Saycmd
do j=1 to Partxxx.0
msg=' '
interpret Saycmd
msg=Partxxx.j.1.1.1.1.1.1.1 /* subjline */
interpret Saycmd
msg=Partxxx.j Partxxx.j.0 Partxxx.j.1.0 Partxxx.j.1.1.0 Partxxx.j.1.1.1.0 Partxxx.j.1.1.1.1.0 Partxxx.j.1.1.1.1.1.0 Partxxx.j.1.1.1.1.1.1.0
interpret Saycmd
if datatype(Partxxx.j.1.0,'N') & datatype(Partxxx.j.1.1.0,'N') & datatype(Partxxx.j.1.1.1.1.0,'N') then do
kmax=max(Partxxx.j.1.0,Partxxx.j.1.1.0,Partxxx.j.1.1.1.1.0)
end
else kmax=3 /* assume max of 3 */
do k=1 to kmax /* max depth of loops */
msg=Partxxx.j Partxxx.j.1
msg=msg||' '||Partxxx.j.1.k
msg=msg||' '||Partxxx.j.1.1.k
msg=msg||' '||Partxxx.j.1.1.k.1
msg=msg||' '||Partxxx.j.1.1.1.1.k
msg=msg||' '||Partxxx.j.1.1.1.1.k.1
interpret Saycmd
end
end
msg=' '
interpret Saycmd
Return
/**************************************************************************/
/* Dumps Miscinfo array for all entries. */
/**************************************************************************/
/* Miscinfo. format: filename.mimetype.decoded.filenoted.chopped.dupfile */
/**************************************************************************/
DumpMiscInfo:
msg=' '
interpret Saycmd
msg='(DUMPMISC=YES)' Files.0 ' File(s)'
interpret Saycmd
msg='format: FPtr Filename Mimetype Decoded Filenoted Chopped Dupfile ("."=missing)'
interpret saycmd
msg=left(dashes,length(msg))
interpret Saycmd
do i=1 to Files.0
if Files.i.1.0=0 then do
msg=i Files.i
msg=msg||' '||Miscinfo.i.1
msg=msg||' '||Miscinfo.i.1.1
msg=msg||' '||Miscinfo.i.1.1.1
msg=msg||' '||Miscinfo.i.1.1.1.1
msg=msg||' '||Miscinfo.i.1.1.1.1.1
interpret Saycmd
end
else do
do j=1 to Files.i.1.0
msg=i Files.i
msg=msg||' '||Miscinfo.i.j
msg=msg||' '||Miscinfo.i.j.1
msg=msg||' '||Miscinfo.i.j.1.1
msg=msg||' '||Miscinfo.i.j.1.1.1
msg=msg||' '||Miscinfo.i.j.1.1.1.1
interpret Saycmd
end
end
msg=' '
interpret Saycmd
end
Return
/**************************************************************************/
/* */
/* Dumps array used for From lines */
/* */
/**************************************************************************/
DumpFrominfo:
msg=' '
interpret Saycmd
msg='(DUMPFROMS=YES)'
interpret Saycmd
msg='Format: Filename SkipFlag DeleteFlag FromLine (0=No 1=Yes)'
interpret saycmd
msg=left(dashes,length(msg))
interpret Saycmd
do j=1 to Files.0 /* dump Frominfo array */
msg=Files.j ' ' Frominfo.j Frominfo.j.1 Frominfo.j.1.1
interpret Saycmd
end
msg=' '
interpret Saycmd
Return
/**************************************************************************/
/* */
/* Dumps array used for Subject lines */
/* */
/**************************************************************************/
DumpSubjinfo:
msg=' '
interpret Saycmd
msg='(DUMPSUBJECTS=YES)'
interpret Saycmd
msg='Format: Filename SkipFlag DeleteFlag SubjectLine (0=No 1=Yes)'
interpret saycmd
msg=left(dashes,length(msg))
interpret Saycmd
do j=1 to Files.0 /* dump Subjinfo array */
msg=Files.j ' ' Subjinfo.j Subjinfo.j.1 Subjinfo.j.1.1
interpret Saycmd
end
msg=' '
interpret Saycmd
Return
/**************************************************************************/
/* */
/* Dumps array used for Date lines */
/* */
/**************************************************************************/
DumpDateinfo:
msg=' '
interpret Saycmd
msg='(DUMPDATES=YES)'
interpret Saycmd
msg='Format: Filename SkipFlag DeleteFlag DateLine (0=No 1=Yes)'
interpret saycmd
msg=left(dashes,length(msg))
interpret Saycmd
do j=1 to Files.0 /* dump Dateinfo array */
msg=Files.j ' ' Dateinfo.j Dateinfo.j.1 Dateinfo.j.1.1
interpret Saycmd
end
msg=' '
interpret Saycmd
Return
/**************************************************************************/
/* */
/* Dumps array used for determining BinTypes */
/* */
/**************************************************************************/
DumpBinTypes:
msg=' '
interpret Saycmd
msg='(DUMPBINTYPES=YES)'
interpret Saycmd
msg=BinTypes.0 ' binary types found in:' BinTypesFile
interpret Saycmd
msg=left(dashes,length(msg))
interpret Saycmd
do j=1 to BinTypes.0 /* dump BinType array */
msg=BinTypes.j
interpret Saycmd
end
msg=' '
interpret Saycmd
Return
/**************************************************************************/
/* */
/* Dumps array used for determining EncTypes */
/* */
/**************************************************************************/
DumpEncTypes:
msg=' '
interpret Saycmd
msg='(DUMPENCTYPES=YES)'
interpret Saycmd
msg=EncTypes.0 ' Encode types found in:' EncTypesFile
interpret Saycmd
msg=left(dashes,length(msg))
interpret Saycmd
do j=1 to EncTypes.0 /* dump Encode array */
msg=EncTypes.j EncTypes.j.1
interpret Saycmd
end
msg=' '
interpret Saycmd
Return
/**************************************************************************/
/* */
/* Dumps array used for determining Base64Types */
/* */
/**************************************************************************/
DumpBase64Types:
msg=' '
interpret Saycmd
msg='(DUMPBASE64TYPES=YES)'
interpret Saycmd
msg=Base64Types.0 ' Base64 types found in:' Base64TypesFile
interpret Saycmd
msg=left(dashes,length(msg))
interpret Saycmd
do j=1 to Base64Types.0 /* dump Base64Type array */
msg=Base64Types.j
interpret Saycmd
end
msg=' '
interpret Saycmd
Return
/**************************************************************************/
/* */
/* Dumps array used for Section Line info */
/* */
/**************************************************************************/
DumpSectionTypes:
msg=' '
interpret Saycmd
msg='(DUMPSECTIONTYPES=YES)'
interpret Saycmd
msg=SectionTypes.0 ' section types found in:' SectionTypesFile
interpret Saycmd
msg=left(dashes,length(msg))
interpret Saycmd
do j=1 to SectionTypes.0 /* dump SectionType array */
msg=SectionTypes.j
do k=1 to SectionTypes.j
msg=msg||' '||SectionTypes.j.k SectionTypes.j.k.k
end
msg=msg||' '||SectionTypes.j.1.1.1 SectionTypes.j.1.1.1.1 SectionTypes.j.1.1.1.1.1 SectionTypes.j.1.1.1.1.1.1
interpret Saycmd
end
msg=' '
interpret Saycmd
Return
/**************************************************************************/
/* */
/* Dumps array used for determining SkipFrom */
/* */
/**************************************************************************/
DumpSkipFroms:
msg=' '
interpret Saycmd
msg='(DUMPSKIPFROMS=YES)'
interpret Saycmd
msg=SkipFroms.0 ' userids in SkipFromFile:' SkipFromFile
interpret Saycmd
msg=left(dashes,length(msg))
interpret Saycmd
do j=1 to SkipFroms.0 /* dump SkipFrom array */
msg=SkipFroms.j
interpret Saycmd
end
msg=' '
interpret Saycmd
Return
/**************************************************************************/
/* */
/* Dumps array used for determining SkipSubject */
/* */
/**************************************************************************/
DumpSkipSubjects:
msg=' '
interpret Saycmd
msg='(DUMPSKIPSUBJECTS=YES)'
interpret Saycmd
msg=SkipSubjects.0 ' keys in SkipSubjectFile:' SkipSubjectFile
interpret Saycmd
msg=left(dashes,length(msg))
interpret Saycmd
do j=1 to SkipSubjects.0 /* dump SkipSubject array */
msg=SkipSubjects.j
interpret Saycmd
end
msg=' '
interpret Saycmd
Return
/**************************************************************************/
/* */
/* Dumps array used for lines with 'BEGIN' */
/* */
/**************************************************************************/
DumpBegins:
msg=' '
interpret Saycmd
msg='(TRAPALLBEGS=YES)'
interpret Saycmd
msg='All lines with BEGIN in ' dirlist.dirptr
interpret Saycmd
msg=left(dashes,length(msg))
interpret Saycmd
do j=1 to AllBegins.0 /* dump Allbegins array */
msg=AllBegins.j
interpret Saycmd
end
msg=' '
interpret Saycmd
Return
/**************************************************************************/
/* */
/* Dumps array used for lines with 'SECTION' */
/* */
/**************************************************************************/
DumpSections:
msg=' '
interpret Saycmd
msg='(TRAPALLSECS=YES)'
interpret Saycmd
msg='All lines with SECTION in ' dirlist.dirptr
interpret Saycmd
msg=left(dashes,length(msg))
interpret Saycmd
do j=1 to AllSections.0 /* dump Frominfo array */
msg=AllSections.j
interpret Saycmd
end
msg=' '
interpret Saycmd
Return
/**************************************************************************/
/* */
/* Dumps array used for MIME encoding lines */
/* */
/**************************************************************************/
DumpEncodes:
msg=' '
interpret Saycmd
msg='(TRAPALLENCS=YES)'
interpret Saycmd
msg='All MIME encoding Lines in ' dirlist.dirptr
interpret Saycmd
msg=left(dashes,length(msg))
interpret Saycmd
do j=1 to AllEncodes.0
msg=AllEncodes.j
interpret Saycmd
end
msg=' '
interpret Saycmd
Return
/**************************************************************************/
/* */
/* Dump all runtime options to output */
/* */
/**************************************************************************/
DumpOpts:
msg=' '
interpret Saycmd
msg='(DUMPOPTS=YES)'
interpret Saycmd
msg='Using these runtime options: (0=NO,1=YES)'
interpret Saycmd
msg=left(dashes,length(msg))
interpret Saycmd
do i=1 to cmd.0
tstr='tval='cmd.i
interpret tstr
msg=' '||cmd.i||'='||tval
interpret Saycmd
end
Return
IOERR:
SIGNAL OFF IOERR
Say 'An I/O error has occurred - exiting'
exit 20
SYNTAX:
SIGNAL OFF SYNTAX
Say 'An unexpected error has occurred - dumping values and exiting'
Say 'Try to identify file with error and edit to fix'
Say 'It is probably the LAST file in one of the arrays'
Say ' '
Say 'Line number with error' SIGL 'RC='RC
Say 'Line with error' sourceline(SIGL)
Say 'Current value of filename:' filename
Say 'Current value of partname:' partname
Say 'Dumping arrays ... '
Call DumpDirs
Call DumpFiles
Call DumpPhase2
Call DumpMiscInfo
signal Cleanup
=============== END OF ACTIVE CODE ================